Excel 2013:复制该房间中计算机数量的行

Excel 2013: copy the row for the number of computers in that room

我的工作簿中有一个工作表,其中包含按房间划分的计算机数量,我想复制该房间中计算机数量的行。我有几个房间需要这样做。

示例:

Room    Count   Model     Year
201      24      MBP      2015

宏有运行

后的结果
Room    Unit    Model     Year     Serial
201      1       MBP      2015      001
201      2       MBP      2015      002
201      3       MBP      2015      003
201      4       MBP      2015      004
201      5       MBP      2015      005

一旦 201 房间的系统计数达到零,我想移动到 202 房间,并在 201 房间的数据块底部做同样的事情,依此类推。

有没有办法在 Excel 中使用 VBA 宏而不是全部输入或复制粘贴?

感谢您的帮助 - 我无法理解我在网上阅读的代码片段。

假设你在 sheet1 中有它,我将粘贴到 sheet2 中

Option Explicit
Sub print_list()
 Dim idx As Integer, ptr As String, ws1 As Worksheet, ws2 As Worksheet, row2 As Integer, c As Integer
Dim i As Integer
Set ws1 = Application.Worksheets(1)
Set ws2 = Application.Worksheets(2)
ws2.Cells(1, 1).Value = "Room"
ws2.Cells(1, 2).Value = "Unit"
ws2.Cells(1, 3).Value = "Model"
ws2.Cells(1, 4).Value = "Year"
ws2.Cells(1, 5).Value = "Serial"
row2 = 2
idx = 2
ws2.Columns(5).NumberFormat = "@"
Do
  ptr = ws1.Cells(idx, 2).Value
  ptr = Trim(ptr)
  If ptr = "" Then Exit Do
  c = CInt(ptr)
  For i = 1 To c
    ws2.Cells(row2, 1).Value = ws1.Cells(idx, 1).Value
    ws2.Cells(row2, 2).Value = i
    ws2.Cells(row2, 3).Value = ws1.Cells(idx, 3).Value
    ws2.Cells(row2, 4).Value = ws1.Cells(idx, 4).Value
    ws2.Cells(row2, 5).Value = Format(i, "00#")
    row2 = row2 + 1
  Next
 idx = idx + 1
Loop While True

End Sub

您需要遍历源工作表中的每一行,根据行中的机器数进行循环,并使用行中的值在循环中将新行添加到目标工作表。

(注意。我个人会为此使用 SQL 语句)

此代码假定源数据在 ActiveSheet 范围内 A1:D19 并且我们 post 在同一工作表中从单元格 F1 开始的输出列表(根据需要更改)

Option Explicit
Option Base 1

Sub ListRoomComputers()
Const kCol As Byte = 6  'Column F

Dim aOutput() As Variant
aOutput = Array("Room", "Unit", "Model", "Year", "Serial")

Dim rDta As Range, rRow As Range
Dim lCnt As Long, lUnit As Long
Dim lRow As Long

    With ActiveSheet

        Rem Set Data Ranges
        Set rDta = .Range("A2:D19")

        Rem Generate Room\Unit\Serial Data
        lRow = 1
        .Cells(lRow, kCol).Resize(, 5).Value = aOutput

        For Each rRow In rDta.Rows

            Rem Get Room Data
            With WorksheetFunction
                aOutput = .Transpose(.Transpose(rRow.Value2))
            End With
            ReDim Preserve aOutput(5)
            lCnt = aOutput(2)

            Rem Fill Room\Unit\Serial Data
            For lUnit = 1 To lCnt
                lRow = 1 + lRow                     'Increase Row Number
                aOutput(2) = lUnit                  'Unit
                aOutput(5) = Format(lUnit, "'000")  'Serial
                .Cells(lRow, kCol).Resize(, 5).Value = aOutput

    Next: Next: End With

End Sub