Question

您好，我需要一个代码，允许我复制粘贴来自名为＆＃34; Target＆＃34;的工作簿中的信息。另一本名为＆＃34; Source＆＃34;根据具体情况而定。

此条件基于代码中找到的唯一项目ID。

我尝试做一些编码，但似乎不允许我得到我想要的结果。

代码只读取第一行并将信息复制到另一个工作簿，而不是查看项目ID＆＃34; 10000327＆＃34;在＆＃34;项目ID＆＃34;目标工作簿中的列，并将信息复制到源工作簿。

下面是我尝试过的代码并给出了我之前提到的结果。

真的希望有人可以帮助我，因为我对VBA很新。谢谢:)）

Sub AAA()    
Dim source As Worksheet
Dim target As Worksheet
    Dim cellFound As Range



    Set target = Workbooks("Target.xlsm").Sheets("Sheet1")
    Set source = Workbooks("Source.xlsm").Sheets("Sheet2")
    lastrow = source.Range("A" & target.Rows.Count).End(xlUp).Row
    lastcol = target.Cells(2, target.Columns.Count).Column

    target.Activate

'For a = 2 To 50
For Each cell In target.Range("A2:A500")
        ' Try to find this value in the source sheet

        Set cellFound = source.Range("A:A").Find(What:="10000327", LookIn:=xlValues, LookAt:=xlWhole)
        If Not cellFound Is Nothing Then

            cell.Offset(ColumnOffset:=1).Copy
            cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues

     Else
     Exit Sub


     End If

Next

Answer 1

我已将硬编码的搜索字词更改为var，以便在连续循环中获取它的pid。

Sub AAB()
    Dim sWS As Worksheet, tWS As Worksheet
    Dim pidCol As Long, pidRow As Long, pidStr As String, rw as long

    Set tWS = Workbooks("Target.xlsm").Sheets("Sheet1")
    Set sWS = Workbooks("Source.xlsm").Sheets("Sheet2")

    With sWS
        With .Cells(1, 1).CurrentRegion
            pidCol = 1
            pidStr = "10000327"  '.Cells(rw, pidCol).Value
            If CBool(Application.CountIf(.Columns(1), pidStr)) Then
                rw = Application.Match(pidStr, .Columns(1), 0)
                With .Cells(rw, 2).Resize(1, .Columns.Count - 1)
                    If CBool(Application.CountIf(tWS.Columns(1), pidStr)) Then
                        pidRow = Application.Match(pidStr, tWS.Columns(1), 0)
                        .Copy Destination:=tWS.Cells(pidRow, 2)
                    End If
                End With
            End If
        End With
    End With

    Set sWS = Nothing
    Set tWS = Nothing
End Sub

这将遍历源工作表上A列（pidCol = 1）中的所有值，如果在目标工作表上找到关联的PID，则将数据复制到目标工作表。

Answer 2

如果我正确理解你的问题，我认为这里发生的是你的for循环为每个单元格运行一次find命令，但它运行相同的find命令，只返回第一个匹配，每个时间。如果你正在使用find命令，我认为你可以更恰当地使用do ... while循环，然后使用＆＃34; findnext。＆＃34; msdn帮助给出了一个例子，我认为这正是你想要做的：

With Worksheets(1).Range("a1:a500") 
Set c = .Find(2, lookin:=xlValues) 
If Not c Is Nothing Then 
    firstAddress = c.Address 
    Do 
        c.Value = 5 
        Set c = .FindNext(c) 
    Loop While Not c Is Nothing And c.Address <> firstAddress 
End If 
End With

另一种选择是检查你的for循环中的每个单元格是否匹配。

将信息从一个工作簿复制到具有特定条件的另一个工作簿

2 个答案: