使用一个工作簿中的列中的值来搜索另一个工作簿中的列

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

我可能不太会获取源数据和目标数据。

真的很混乱

无论如何，你可以玩弄它来让它工作:)