excel - 基于数组复制整个列并将其粘贴到同一工作簿中的工作表中

Question

我正在尝试复制特定列(以任何顺序)，如果标题与数组中的字符串匹配，则这些列将复制到目标工作表 EmptyCells。

无论列数如何，仅复制数组中的最后一列。

例如:

1) HeaderName = Array("业务影响", "类型")
- 仅复制类型

2) HeaderName = Array("Business Impact", "Typology","ABCD")
- 仅复制 ABCD

我尝试使用 Destination:=trg.Range(.......) 的变体.

Sub Sup_DelCol()

    Dim i As Long, MaxColumns As Long
    Dim j As Long
    Dim HeaderName As Variant
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim LastRow As Long

    '##Source Worksheet
    Set src = ThisWorkbook.Worksheets("general_report")

    '##Target Worksheet
    Set trg = ThisWorkbook.Sheets.Add(After:= _
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    trg.Name = "EmptyCells"


    'Column Names
    HeaderName = Array("Business Impact", "Typology")

    'Copy the columns where the header matches the strings in the array
    MaxColumns = src.UsedRange.Columns.Count

    For j = 0 To UBound(HeaderName, 1)
        For i = MaxColumns To 1 Step -1
            If src.Cells(1, i).Value = HeaderName(j) Then src.Cells(1, i).EntireColumn.Copy Destination:=trg.Range(.....)
        Next i
    Next j

End Sub

预期结果(基于当前数组):

工作表 EmptyCells(2 列)-
业务影响(A 栏)；类型学(B 列)

Answer 1

根据我从您的代码中可以理解的内容，我认为您的意思是循环浏览您的 .UsedRange.Cell , 而不是仅仅使用 .Cell .

应用这些更正应该可以解决问题。更改此代码:

For j = 0 To UBound(HeaderName, 1)
     For i = MaxColumns To 1 Step -1
            If src.Cells(1, i).Value = HeaderName(j) Then src.Cells(1, i).EntireColumn.Copy Destination:=trg.Range(.....)
    Next i
Next j

为此(我删除了内联 If 以提高可读性):

For j = 0 To UBound(HeaderName, 1)
     For i = MaxColumns To 1 Step -1
            If src.UsedRange.Cells(1, i).Value = HeaderName(j) Then
               src.UsedRange.Cells(1, i).EntireColumn.Copy _ 
               Destination:=trg.cells(1,columns.count).end(xltoleft).offset(,1)
            End If
    Next i
Next j

Note: I tested this code in my Excel and now it effectively cycles through all the headers.

编辑

添加@SJR 代码重新保护rng为了完整性。

我希望这有帮助。