我正在尝试复制特定列(以任何顺序),如果标题与数组中的字符串匹配,则这些列将复制到目标工作表 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 列)
最佳答案
根据我从您的代码中可以理解的内容,我认为您的意思是循环浏览您的 .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.
编辑
rng
为了完整性。 我希望这有帮助。
关于excel - 基于数组复制整个列并将其粘贴到同一工作簿中的工作表中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/58165161/