Question

我有两个电子表格（wb1和wb2）。目标是选择wb1列D中的每个值，找到wb2列C中的值，然后将一系列单元格（与搜索值相同的行）复制回wb1。

这是迄今为止我设法汇总的代码：

    Dim rng1 As Range, rng2 As Range
    Dim cell as Variant
    Dim cell_val as String    
    Dim wb1 as Workbook, wb2 as Workbook
    Dim sh1 as Worksheet, sh2 as Worksheet

    Sub Find_Copy_Paste()

    set wb1 = Workbooks.Open("c:\explicit\path\to\wb1.xlsm")  <---This fails    
    set wb2 = Workbooks.Open("c:\explicit\path\to\wb2.xlsm")  <---This fails

    Set sh1 = wb1.Open("Inventory")    
    set sh2 = wb2.Open ("Sheet1")

    set rng1 = wb1.sh1.Range("D6:D1702")
    set rng2 = wb2.sh2.Range("C2:C3132")

    For Each cell In rng1
        ActiveCell.Select
        cell_val = Selection.Copy
        Windows(wb2).Activate
        Cells.Find(What:=(cell_val), After:=ActiveCell, 
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, 
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset (0,1).Range("A1:AH1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(wb1).Activate
        ActiveCell.Offset(0,1).Range("A1").Select
        ActiveSheet.Paste
        cell_val=""
    Next

    End Sub

不幸的是，我遇到了挑战，我怀疑它与两件事有关：1）wb1和wb2变量以及我如何分配它们，以及2）Cells.Find部分中的变量代码（但我对VBA来说还是比较新的，所以我的怀疑可能还有一段距离）。

Answer 1

在下面尝试此操作，我只使用了一个工作簿来模拟您的目标。如果宏和＆amp;路径不受信任，您可能有问题打开xlsm文件。在这里，我只有其中一个处于ReadOnly模式（工作簿2）。

Sub Find_Copy_Paste()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim cell As Range, FoundCells As Range

    Set wb1 = Workbooks.Open(Filename:="c:\explicit\path\to\wb1.xlsm",ReadOnly:=False)
    Set wb2 = Workbooks.Open(Filename:="c:\explicit\path\to\wb2.xlsm",ReadOnly:=True)

    Set sh1 = wb1.Worksheets("Inventory")
    Set sh2 = wb2.Worksheets("Sheet1")

    Set rng1 = sh1.Range("D6:D1702")
    Set rng2 = sh2.Range("C2:C3132")

    For Each cell In rng1
        If Not IsEmpty(cell) Then
            Set FoundCells = rng2.Find(cell.Value)
            If Not FoundCells Is Nothing Then
                Debug.Print """" & cell.Value & """ found at " & FoundCell.Worksheet.Name & "!" & FoundCell.Address
                ' Copy Found cell to one column on right of cell being searched for
                FoundCells.Copy Destination:=cell.Offset(0, 1)
            End If
        End If
    Next
    Set rng1 = Nothing
    Set rng2 = Nothing
    Set sh1 = Nothing
    Set sh2 = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
End Sub

有许多开始学习VBA的好地方，对于Excel 2010，请查看Excel Developer Reference。

VBA-Excel - Cells.Find中的变量

1 个答案: