Question

以下宏用于将一个工作表（具有可变列顺序，但列名相同）的列标题下的内容复制到另一个工作表（现在一个列旁边的一个列）。问题是在嵌入的For Each循环的第一次迭代之后，条件“cell = header”不再成立，因为“Next cell”显然尚未执行。有没有解决方法或我必须完全重写？

Sub CopyContentBelowHeadersToAnotherSheet ()

Dim headers As Range
Dim cell As Variant
Dim header As Variant
Dim CopiedHeaders As Variant
Dim is as Variant



Set headers = Workbooks("GL audit template 3.0.xlsm").Worksheets ("Sheet3").Range("A1:Z1")
CopiedHeaders = Array("DocumentNo", "G/L", "Type", "Tx", "Text", "BusA", "Doc. Date", "Amount in local cur.")
i = 1

For Each cell In headers
    For Each header In CopiedHeaders
         If cell = header Then ' this is no longer true after first iteration of this loop 
          cell.Offset(1, 0).Activate 
          Range(ActiveCell, ActiveCell.End(xlDown)).Copy
          Workbooks("GL audit template 3.0.xlsm").Worksheets("Sheet1").Activate
          Cells(2, i).Activate
          ActiveSheet.Paste
          i = i + 1
        End If
    Next header
Next cell

End Sub

Answer 1

请摆脱那些缓慢而无用的Activate和ActiveCell！我没有测试，但这应该更好。

For Each cell In headers
    For Each header In CopiedHeaders
         If cell = header Then ' this is no longer true after first iteration of this loop 
          With cell
             Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Copy
             Workbooks("GL audit template 3.0.xlsm").Worksheets("Sheet1").Cells(2, i).Paste
          End with
          i = i + 1    'edited
        End If
    Next header
Next cell

在第一次迭代后，嵌入的“for each”循环条件不成立

1 个答案: