我有一個列標題陣列，按我需要的順序排列。我想使用此陣列在 Excel 作業表中查找列標題并將列復制到新作業表。作業表中可能不存在一個或多個列，因此如果找不到該列，我希望它跳過該列。
如果所有列始終都在作業表中，這是我到目前為止作業正常的內容，但是如果列不存在，則它不起作用。
Option Explicit
Sub MoveCol2() 'Excel VBA to move Columns based on criteria
Dim ar As Variant
Dim i As Integer
Dim j As Long
'Set the Array Values
ar=Array("Sales", "Dept 1", "Dept 8", "Dept 9")
For i=0 To UBound(ar) 'Loop through the Array
j=[A1:S1].Find(ar(i)).Column
Columns(j).Copy Sheet2.Cells(1, i 1) 'Add 1 at end as array starts at 0
Next i
End Sub
長話短說，這里的目標是，如果列標題不在作業表中，則不要拋出錯誤并移至陣列中的下一個列標題。
與往常一樣，提前感謝大家提供的任何幫助。
uj5u.com熱心網友回復：
我會制作一個通用程式，您可以使用不同的引數呼叫它，以便您可以將它重新用于類似的問題。
此外，我會先收集所有列，Union然后立即復制它們（這要快得多）。
Option Explicit
Public Sub example()
CopyColumns Array("Sales", "Dept 1", "Dept 8", "Dept 9"), ThisWorkbook.Worksheets("Sheet1"), ThisWorkbook.Worksheets("Sheet2")
End Sub
Public Sub CopyColumns(ByVal ColumnList As Variant, ByVal wsSource As Worksheet, ByVal wsDestination As Worksheet)
Dim ColumnsToCopy As Range ' we collect all colums to copy here
Dim ColumnName As Variant
For Each ColumnName In ColumnList
Dim FoundAt As Range
Set FoundAt = Nothing ' initialize because we are in a loop
Set FoundAt = wsSource.Rows(1).Find(What:=ColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
' check if column name was found
If Not FoundAt Is Nothing Then
If ColumnsToCopy Is Nothing Then
' first column found
Set ColumnsToCopy = FoundAt.EntireColumn
Else
' addinional columns are added with union
Set ColumnsToCopy = Application.Union(ColumnsToCopy, FoundAt.EntireColumn)
End If
End If
Next ColumnName
' if colums were found copy them at once
If Not ColumnsToCopy Is Nothing Then
ColumnsToCopy.Copy Destination:=wsDestination.Cells(1, 1)
Else
MsgBox "No columns were found to copy", vbExclamation
End If
End Sub
請注意，在使用Range.Find 方法時，您應該指定一些引數，否則 find 的結果可能會隨機作業或不作業。您還需要檢查是否完全找到了某些東西（這是您遇到的錯誤）。
最后我會呼叫該程式，CopyColumns而不是Move因為您復制并且不要移動！命名很重要，如果你錯誤地命名你的函式，你很容易在使用它時陷入地獄。
uj5u.com熱心網友回復：
您需要檢查第一個的結果Find。如果 沒有結果Find，則沒有結果.Column，因此會出錯。
Sub MoveCol2()
Dim ar As Variant
Dim i As Integer
Dim j As Long
Dim result As Variant
ar = Array("Sales", "Dept 1", "Dept 8", "Dept 9")
For i = 0 To UBound(ar)
Set result = [A1:S1].Find(ar(i), LookAt:=xlWhole)
If Not result Is Nothing Then
j = result.Column
Columns(j).Copy Sheet2.Cells(1, i 1)
End If
Next
End Sub
按評論編輯
Sub MoveCol2()
Dim ar As Variant
Dim i As Integer
Dim j As Long
Dim result As Variant
Dim destCol As Long
ar = Array("Sales", "Dept 1", "Dept 8", "Dept 9")
For i = 0 To UBound(ar)
Set result = [A1:S1].Find(ar(i), LookAt:=xlWhole)
If Not result Is Nothing Then
j = result.Column
destCol = destCol 1
Columns(j).Copy Sheet2.Cells(1, destCol)
End If
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/314271.html