使用一個工作簿中的列的值來搜索另一個工作簿中的列

Question

我在使用下面的代碼時遇到問題。

我正在嘗試使用wb2中“A”列的值來搜索wb1中的“G”列。

wb2中的列“A”包含一長串數字，我正在嘗試在wb1中的“G”列中搜索該數字的完全匹配。

當匹配時我需要它將wb2中正確行的列“AF”的值設置為來自wb1的相應匹配，但是從另一列，可能是列“Z”而不是“G”。

運行宏時，工作簿已經打開。

希望你能幫助我。

提前致謝。

Sub ROAC()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet


Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")

LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb1.Sheets("Period").Range(wb1.Sheets("Period").Range("G1"), wb1.Sheets("Period").Range("G1").End(xlDown)).Rows.Count
LastRowWb2 = wb2.Sheets("Oversigt").Range(wb2.Sheets("Oversigt").Range("A1"), wb2.Sheets("Oversigt").Range("A1").End(xlDown)).Rows.Count

For y = 7 To LastRowWb1
For x = 1 To LastRowWb2


If wb1.Sheets("Period").Range("G" & y).Value = wb2.Sheets("Oversigt").Range("A" & x).Value Then

wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & y)

End If

Next x
Next y

End Sub

Answer 1

以下是我將如何執行您的要求（假設我無論如何都清楚地理解它！）。 此代碼循環遍歷wb2中列A中的所有行，並對wb1中的列G執行查找操作。 在找到它的地方，它將wb2中的AF列設置為同一行中wb1的Z列的值。

Sub ROAC()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet

Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set wb1sht = wb1.Worksheets("Period")
Set wb2sht = wb2.Worksheets("oversigt")

LastRowWb1 = wb1sht.Cells(wb1sht.Rows.Count, "G").End(xlUp).Row
LastRowWb2 = wb2sht.Cells(wb2sht.Rows.Count, "A").End(xlUp).Row

For y = 1 To LastRowWb2
    findMe = wb2sht.Range("A" & y).Value
    With wb1sht.Range("G7:G" & LastRowWb1)
        Set oFound = .Find(findMe)
        If Not oFound Is Nothing Then
            ' Found number - set AF in wb2 on this row to Z on the same row from wb1
            wb2sht.Range("AF" & oFound.Row).Value = wb1sht.Range("Z" & oFound.Row).Value
        Else
            ' Didn't find number, so do whatever you might need to do to handle this in here...
        End If
    End With
Next

End Sub

Answer 2

這應該解決你的問題（我沒有在VBA中寫這個，所以可能有奇怪的語法問題）。

從本質上講，你可以在wb1中“找到”你的值，如果它在那里將該值粘貼到wb2中。

Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Dim fndRange as Range
Dim wb1Value as variant       

Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")

LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb2.Sheets("Period").Range("G" & Rows.Count).End(xlUp).Row
LastRowWb2 = wb2.Sheets("Oversigt").Range("A" & Rows.Count).End(xlUp).Row

For y = 7 To LastRowWb1

    wb1Value = wb1.Sheets("Period").Range("G" & y).Value

    Set fndRange = wb2.Sheets("Oversigt").Range("A1:A" & LastRowWb2).Find(What:= wb1Value)

    If Not fndRange is Nothing Then
        wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & fndRange.Row)
    End If

Next y

End Sub

Answer 3

Sub ROAC()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Target_Data As Range
Dim y As Integer

'Since you were using same sheets over and over, I just set ws1 and ws2 
'instead of writing Wb1.Sheets("Period") wb2.Sheets("Oversigt") everytime
Set ws1 = Workbooks("EP_BB_DK_ny.xlsm").SHEETS("Period")
Set ws2 = Workbooks("Laaneoversigt.xlsm").SHEETS("Oversigt")

lastrow = ws2.Cells(ws2.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = ws1.Range(ws1.Range("G1"), ws1.Range("G1").End(xlDown)).Rows.Count

For y = 7 To LastRowWb1

''''This compares ws1.Range("G" & y) with ws2.Column A and set Target_Data as matching range 
    Set Target_Data = ws2.Columns("A").Find(ws1.Range("G" & y).Value)

''''This check if the Target_data found data or not (Find method will return Nothing if it doesn't find it.)
    If Not (Target_Data Is Nothing) Then

''''''''This will write ws1. Column Z's data to ws2. Column AF on same row as where the data is found
        ws2.Range("AF" & Target_Data.Row) = ws1.Range("Z" & y)

    End If
Next y

End Sub

我可能很少獲得源數據和目標數據。

這真的令人困惑

無論如何，你可以玩它來使它工作:)