我正在嘗試在下面的代碼上創建一個回圈，因此如果 A 列與 B 列有多個匹配項，它會繼續使用 A 列中的資料填充 B 列。
有人建議我創建變體陣列和回圈陣列，但在研究之后我還沒有那么先進。謝謝。
Sub Test_match_fill_data()
Dim aCell
Dim e, k As Long, matchrow As Long
Dim w1, w2 As Worksheet
Dim cell As Range
Set w1 = Workbooks("Book1").Sheets("Sheet1")
Set w2 = Workbooks("Book2").Sheets("Sheet2")
e = w1.Cells(w1.Rows.Count, 1).End(xlUp).Row
k = w2.Cells(w2.Rows.Count, 1).End(xlUp).Row
For Each aCell In w1.Range("A2:A" & e)
On Error Resume Next
matchrow = w2.Columns("A:A").Find(What:=Left$(aCell.Value, 6) & "*", LookAt:=xlWhole).Row
On Error GoTo 0
If matchrow = 0 Then
Else
w2.Range("B" & matchrow).Value = aCell.Offset(0, 1).Value
End If
matchrow = 0
Next
End Sub
uj5u.com熱心網友回復：
如果您在 Book1 中搜索 Book2 中的值，您的代碼將起作用。這是一個陣列版本。
Option Explicit
Sub Test_match_fill_data()
Dim w1 As Worksheet, w2 As Worksheet
Dim ar1, ar2, matchrow, n As Long
Dim lastRow As Long, i As Long, s As String
Set w1 = Workbooks("Book1").Sheets("Sheet1")
With w1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
ar1 = .Range("A2:B" & lastRow).Value2
End With
Set w2 = Workbooks("Book2").Sheets("Sheet2")
With w2
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
ar2 = .Range("A2:B" & lastRow).Value2
End With
For i = 1 To UBound(ar2)
s = Left(ar2(i, 1), 6)
If Len(s) > 0 Then
matchrow = Application.Match(s & "*", Application.Index(ar1, 0, 1), 0)
'Debug.Print i, s, matchrow
If Not IsError(matchrow) Then
ar2(i, 2) = ar1(matchrow, 2)
n = n 1
End If
End If
Next
' copy array back to sheet
w2.Range("A2:B" & UBound(ar2) 1) = ar2
MsgBox n & " rows updated"
End Sub
uj5u.com熱心網友回復：
您可以使用 INDEX/MATCH 公式 - 然后用值替換結果 - 不需要陣列等。
我把我的假設放在代碼中
Sub insertConsultants()
Dim wb1 As Workbook
Set wb1 = Workbooks("wb1.xlsx")
Dim rgDataSource As Range
'Assumption: Make = column A - first value in A3
'maybe you have to adjust this to your needs
'CurrentRegion: no empty rows within in data area
Set rgDataSource = wb1.Worksheets(1).Range("A3").CurrentRegion
Dim wb2 As Workbook: Set wb2 = Workbooks("wb2.xlsx")
Dim rgTarget As Range
'Assumption: Make = column A - first value in A3
'maybe you have to adjust this to your needs
Set rgTarget = wb2.Sheets(1).Range("A3").CurrentRegion
With rgTarget .Offset(, 1).Resize(, 1)
' = consultants column
.Formula = "=INDEX(" & rgDataSource.Columns(2).Address(True, True, , True) & ",MATCH(A3," & rgDataSource.Columns(1).Address(True, True, , True) & ",0))"
.Value = .Value
End With
End Sub
重要提示：您始終必須單獨定義每個變數：
您的代碼Dim w1, w2 As Worksheetw1 是一個變體，而不是作業表。這可能會導致錯誤。
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/355591.html