Question

我有2个wb to_update_example_1和purchasing_list

基本上我想要做的是在工作簿to_update_example_1上逐行循环，如果找到相同的名称将变量复制到purchasing_list工作簿。

然而，它一直在搜索部分给我错误91，我需要一个建议如何将vVal2（这是数量）写入采购列表工作簿，列就在找到的位置旁边名称，所以我试图使用活动单元格偏移，但也没有工作

感谢任何建议

Sub Macro1()

Application.ScreenUpdating = False

Dim x As Integer
Dim vVal1, vVal2 As String

Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count ' Set numrows = number of rows of data.
Range("A1").Select  ' Select cell a2.
For x = 1 To Numrows ' Establish "For" loop to loop "numrows" number of times.
    vVal1 = Cells(x, 8)
    vVal2 = Cells(x, 7)

    Windows("Purchasing List.xls").Activate

    ActiveSheet.Cells.Find(What:=vVal1, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row

    ''write to Qty cell beside the found name ActiveCell.Offset(0, -2) = vVal2
    Windows("To_update_example_1.xlsm").Activate

    ''''''''ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True

End Sub

Answer 1

使用Find函数时，建议您将Range对象设置为Find结果，并为Find没有'的方案准备代码在vVal1工作簿中找到"Purchasing List.xls"。您可以使用以下行If Not FindRng Is Nothing Then来实现它。

注意：避免使用Select，Activate和ActiveSheet，而是完全限定所有对象 - 请参阅下面的代码（带注释）。< / p>

修改后的代码

Option Explicit

Sub Macro1()

Application.ScreenUpdating = False

Dim x As Long, Numrows As Long
Dim vVal1 As String, vVal2 As String
Dim PurchaseWb As Workbook
Dim ToUpdateWb As Workbook
Dim FindRng As Range

' set workbook object of "Purchasing List" excel workbook
Set PurchaseWb = Workbooks("Purchasing List.xls")

' set workbook object of "To_update_example_1" excel workbook
Set ToUpdateWb = Workbooks("To_update_example_1.xlsm")

With ToUpdateWb.Sheets("Sheet1") ' <-- I think you are trying to loop on "To_update_example_1.xlsm" file , '<-- change "Sheet1" to your sheet's name
    ' Set numrows = number of rows of data.
    Numrows = .Range("A1").End(xlDown).Row

    For x = 1 To Numrows ' Establish "For" loop to loop "numrows" number of times
        vVal1 = .Cells(x, 8)
        vVal2 = .Cells(x, 7)

        ' change "Sheet2" to your sheet's name in "Purchasing List.xls" file where you are looking for vVal1
        Set FindRng = PurchaseWb.Sheets("Sheet2").Cells.Find(What:=vVal1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns)
        If Not FindRng Is Nothing Then '<-- make sure Find was successful finding vVal1
            ' write to Qty cell beside the found name ActiveCell.Offset(0, -2) = vVal2
            ' Not sure eactly what you want to do now ???

        Else ' raise some kind of notification
            MsgBox "Unable to find " & vVal1, vbInformation
        End If
    Next x
End With

Application.ScreenUpdating = True

End Sub

Answer 2

已编辑以说明OP关于搜索和写入值的位置的评论

ShaiRado已经告诉你缺陷在哪里

这是一个替代代码

Option Explicit

Sub Macro1()
    Dim cell As Range, FindRng As Range

    Dim purchListSht As Worksheet
    Set purchListSht = Workbooks("Purchasing List.xls").Worksheets("purchaseData") '(change "purchaseData" to your actual "purchase" sheet name)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Workbooks("to_update_example_1").Sheets("SourceData") ' reference your "source" worksheet in "source" workbook (change "SourceData" to your actual "source" sheet name)
        For Each cell In .Range("H1", .Cells(.Rows.Count, 8).End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced "source" sheet column "H" not empty cells
            Set FindRng = purchListSht.Columns("G").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns) ' try finding current cell content in "purchase" sheet column "G"
            If Not FindRng Is Nothing Then FindRng.Offset(, -2).Value = cell.Offset(, -1).Value ' if successful, write the value of the cell one column left of the current cell to the cell two columns to the left of found cell
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

从不同的工作簿中搜索并复制值

2 个答案: