Question

我有一个小样本示例数据表，如果我可以使这个过程工作，将填充更多数据。

我要做的是，根据每行填充的单元格数量，在同一行下插入相同数量的空白行，并将所有空白列复制到所有列。我附上了两个截图 - 开始和结束之前和之后的截图，以及用于实现空白行插入的代码。到目前为止，它所做的只是一致地添加8行，并使用旧版本的Excel。我试图将其翻译成新的VBA格式，但我似乎无法让它发挥作用。

开始：

我试图实现的结果：

代码：

Sub IfYes()
Dim Col As Variant
Dim Y As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim C As Long
Dim StartRow As Long
Col = "AS"
Y = "Y"
StartRow = 1
BlankRows = 1
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
Application.ScreenUpdating = False
With ActiveSheet
  For R = LastRow To StartRow + 1 Step -1
      If .Cells(R, Col) = "Yes" Then
            .Cells(R, Col).Offset(1, 0).Resize(8, 1).EntireRow.Insert
            .Cells(R, StartRow).Offset(1, 0).Resize(8, 1).Value = .Cells(R, 1).Value
            For C = 1 To 8 Step 1
               .Cells(R, Y).Offset(C, 0).Value = .Cells(R, Col).Offset(0, C).Value
            Next C
            .Cells(R, Col) = "Done"
      End If
  Next R
End With
Application.ScreenUpdating = True
   End Sub

我还有一些代码，我一直在努力使其正常运行。

Dim wb1 As Workbook, ws1 As Worksheet
Dim lRow As Long
Dim LastRow As Range
Dim StartRow As Range
Dim i As Long

Set wb1 = Application.Workbooks.Open("Z:\Employee Folders\Jason\crystal spreadsheet - start.xls")
Set ws1 = wb1.Worksheets("AMZStart")

With ws1
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 1 Step -1
    If Cells(lRow, "B") = "AMZ" Then Rows(lRow).Offset(1, 0).EntireRow.Insert
Next lRow
LastRow = Range("C" & Rows.Count).End(xlUp).Row + 1
StartRow = 1
For i = StartRow To LastRow
If Cells(i, "C") = "" And i > StartRow Then
Cells(i, "C").Formula = "=SUM(C" & StartRow & ":C" & i - 1 & ")"
StartRow = i + 1
End If
Next
End With
End Sub

Answer 1

我发现将值存储在变量数组中会有所帮助。

Sub expand_Entries()
    Dim v As Long, vAMZs As Variant, vVALs As Variant
    Dim rw As Long, c1 As Long, c2 As Long, c As Long, cs As Long

    With Worksheets("Sheet2")
        c1 = Application.Match("status", .Rows(1), 0)
        c2 = .Cells(1, Columns.Count).End(xlToLeft).Column
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            cs = Application.CountA(.Cells(rw, c1 + 1).Resize(1, c2 - c1))
            If CBool(cs) Then
                vVALs = .Cells(rw, 1).Resize(1, c1 - 1).Value2
                With .Cells(rw, c1).Resize(1, cs + 1)
                    vAMZs = .Cells.Value2
                    .Offset(0, 1).ClearContents
                End With
                For c = UBound(vAMZs, 2) To LBound(vAMZs, 2) + 1 Step -1
                    .Cells(rw + 1, 1).Resize(1, c1 - 1).EntireRow.Insert
                    .Cells(rw + 1, 1).Resize(1, c1 - 1) = vVALs
                    .Cells(rw + 1, 8) = vAMZs(1, c)
                Next c
            End If
        Next rw
    End With
End Sub

Answer 2

您可以使用CountA块中的IF工作表功能来确定已填充单元格的数量。然后只需将8＆替换为每行的计数。

参见代码：

  If .Cells(R, Col) = "Yes" Then

        'get count
        Dim iCells As Integer
        iCells = WorksheetFunction.CountA(.Range("A" & R & ":R" & R))

        .Cells(R, Col).Offset(1, 0).Resize(iCells, 1).EntireRow.Insert
        .Cells(R, StartRow).Offset(1, 0).Resize(iCells, 1).Value = .Cells(R, 1).Value

        For C = 1 To iCells Step 1
           .Cells(R, Y).Offset(C, 0).Value = .Cells(R, Col).Offset(0, C).Value
        Next C

        .Cells(R, Col) = "Done"

  End If

根据填充的单元格数（在每列中）插入空行

2 个答案: