Excel VBA - 按照表中的描述添加行

Question

我正在尝试复制this view其中底部表格中的新行是根据顶部表格“A”列中的值创建的。

这是我的代码:

Sub testProc()
Worksheets("Sheet1").Activate
Dim r, count As Range
Dim LastRow As Long
Dim temp As Integer
'Dim lngLastRow As Long

Set r = Range("A:L")
Set count = Range("A:A")
LastRow = Range("F" & 9).End(xlUp).Row
'LastRow = Cells(Rows.count, MyRange.Column).End(xlUp).Row
For n = LastRow To 1 Step -1
    temp = Range("A" & n)
    If (temp > 0) Then
        Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
        Range("H" & (ActiveCell.Row) - 2).Copy Range("E" & (ActiveCell.Row) - 1)
        Range("G" & (ActiveCell.Row)).Select

        'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Activate
        'Cells(ActiveRow, 8).Value.Cut
        'Cells.Offset(2 - 6).Value.Paste

        'Range("G" & (ActiveCell.Row)).Select
        'ActiveCell.Offset(0 - Selection.Column + 1).Range("A1:AG1").Select
        'Value = Range(G, H)
        'ActiveCell.Offset(1, -6).Paste
        'ActiveCell.Offset(1, -6).Paste
        'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Paste

        'Range.Offset(1, -6).Paste
        'Value = Range("G" & (ActiveCell.Row), "H" & (ActiveCell.Row)).Value

        'ActiveCell.Offset(2, -6).Range


        'ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate

    End If
Next n
End Sub

我不知道自己在做什么，无论有没有消息，Excel 都会崩溃

Answer 1

最简单的解决方案是使用两个单独的工作表，但是您可以通过一些数学或带有保留字的单元格轻松解决这个问题。您还希望使用尽可能少的引用变量，并让 Excel 告诉您通过使用连续范围来定义范围。

我不会为您编写整个函数，而是为您提供构建 block ，让您将其拼凑在一起，并希望您在这样做时能学到更多。

以下是如何设置您将在整个代码中引用的对象变量:

Dim sourceSheet as Worksheet
Dim targetSheet as Worksheet

' replace with the names of sheets you want to use
sourceSheet = Worksheets("Sheet1")
targetSheet = Worksheets("Sheet2")

现在，for 循环源表。如果您知道工作表中的第一行始终是标题行，并且您的指令从第 2 行开始，那么您可以使用它循环遍历每个指令:

Dim sourceRowIndex = 2

While Not IsEmpty(sourceSheet.cells(sourceRowIndex, 1))

  ' ** do stuff here

  ' increment row index
  sourceRowIndex = sourceRowIndex + 1

Wend

您还可以使用 For Each 循环、For Next 或 Do While，一旦您了解了所使用的逻辑，就可以选择。

请注意，“单元格”采用两个数字 - 行号和列号。当您循环访问一系列行和列并且不想处理 A1 或 C5 等地址时，这非常方便。

这将循环遍历顶部表中的所有内容，但现在您需要添加一个内部循环来实际处理指令。将以下所有代码添加到 While 之后、Wend 之前。

最后，您需要将行添加到目标。这里的技巧是使用 CurrentRegion 属性来确定范围中最后一行的位置，然后只需添加一个即可获取下一个空白行。

Dim targetFirstEmptyRow

' Look up the Current Range of cell A1 on target worksheet
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRegion.Rows + 1

然后赋值不要使用复制粘贴，直接赋值即可。这将写入您定义的第一行:

targetSheet.cells(targetFirstEmptyRow, 1).value = sourceSheet.cells(sourceRowIndex, 1).value
targetSheet.cells(targetFirstEmptyRow, 4).value = sourceSheet.cells(sourceRowIndex, 4).value
targetSheet.cells(targetFirstEmptyRow, 5).value = sourceSheet.cells(sourceRowIndex, 5).value

然后，在写出这三个值后，您可以再次使用它来获取下一个空行(请注意，您的 sourceRowIndex 尚未更改):

targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRange.Rows + 1

使用单元格(行、列)逻辑，编写第二行也很容易:

targetSheet.cells(targetFirstEmptyRow, 2).value = sourceSheet.cells(sourceRowIndex, 6).value
targetSheet.cells(targetFirstEmptyRow, 3).value = sourceSheet.cells(sourceRowIndex, 7).value
targetSheet.cells(targetFirstEmptyRow, 6).value = "Dev"

添加第三行(当需要时)几乎与第二行完全相同。但是，您想要检查第三行是否是必要的:

If sourceWorksheet.cells(sourceRowIndex, 1) = 3 Then
  ' insert your third row here
End If

这是伪代码中的整个函数，因此您可以将它们拼凑在一起:

Set up worksheet variables
While loop through every Source row
  Find next empty row in Target
  Copy Row 1
  Find next empty row in Target
  Copy Row 2
  If 3 rows
    Find next empty row in Target
    Copy Row 3
  Increment Source Row Index
Wend

最后，如果您不想看到屏幕闪烁(并且希望加快代码执行速度)，请查看 Application.Screenupdating 以关闭屏幕重绘，因为这会发挥作用。只要记住在处理完所有内容后再次打开它即可。