Excel VBA-如表中所述添加行 [英] Excel VBA - Add rows as described in a table

问题描述

我正在尝试复制此视图，其中底部表格中的新行是根据顶部表格的"A"列中的值创建的.

I am trying to replicate this view where new rows in the bottom table are created based on the values in Column'A' of the top table.

这是我的代码:

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崩溃了，没有消息

I do not know what I am doing and Excel is crashing with and without messages

推荐答案

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

The easiest solution to this would be to use two separate worksheets, but you can work around this pretty easily with some math or a cell with a reserved word. You also want to use as few reference variables as possible and let Excel tell you what the ranges are defined as by using contiguous ranges.

我不会为您编写整个功能，而是为您提供构建基块，使您可以将其组合在一起，并希望您能从中学到更多的知识.

I'm not going to write the whole function for you, but give you the building blocks that will let you piece it together and hopefully you'll learn more as you do it.

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

Here's how to set up the object variables that you'll reference throughout the code:

Dim sourceSheet as Worksheet
Dim targetSheet as Worksheet

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

现在，用于遍历源表.如果您知道工作表中的第一行始终是标题"行，并且您的说明从第2行开始，那么您可以使用它来遍历每条说明:

Now, for looping through the source table. If you know that the first row in the Sheet is always the Title row and your instructions start in row 2 then you can use this to loop through every instruction:

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，一旦了解所使用的逻辑，就可以选择.

You could also use a For Each loop or a For Next or a Do While, take your pick once you understand the logic used.

请注意，单元格"有两个数字-行号和列号.当您遍历一系列行和列并且不想处理诸如A1或C5之类的地址时，这非常方便.

Note that "Cells" takes two numbers - the row number then the column number. This is very handy when you're looping through a series of rows and columns and don't want to have to deal with addresses like A1 or C5.

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

This will loop through everything in the top table, but now you need to add an inner loop that will actually process the instructions. Add all of the code below after the While and before the Wend.

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

Finally, you need to add the rows to the Target. The trick here is to use the CurrentRegion property to figure out where the last row in the range is, then just add one to get the next blank row.

Dim targetFirstEmptyRow

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

然后分配值不使用复制和粘贴，只需直接分配值即可.这将写入您定义的第一行:

Then to assign values don't use copy and paste, just assign the values directly. This will write the first row you have defined:

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并未更改):

Then after you write out those three values you can get the next empty row by using this again (note that your sourceRowIndex hasn't changed):

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

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

Using the cells(row, column) logic it's pretty easy to write the second row as well:

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"

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

Adding the third row (when it's required) is nearly exactly the same as the second. However, you want to check to see if the third row is necessary:

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

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

Here's the entire function in pseudo-code so you can piece it all together:

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以关闭屏幕重绘，因为这样做是可行的.只要记得在处理完所有内容后再次将其打开即可.

Finally, if you don't want to see the screen flashing (and you want to speed the code execution up a little) look into Application.Screenupdating to turn off screen redraw as this does its work. Just remember to turn it on again once you've finished processing everything.

这篇关于Excel VBA-如表中所述添加行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！