/ / Wyszukiwanie z innego skoroszytu i kopiowanie wartości - excel, vb.net, vba, excel-vba

Wyszukiwanie z innego skoroszytu i kopiowanie wartości - excel, vb.net, vba, excel-vba

Mam 2 wb to_update_example_1 i purchasing_list

w zasadzie to, co próbuję zrobić, to wiersz pętli po wierszu na skoroszycie to_update_example_1 jeśli zostanie znaleziona ta sama nazwa, która skopiuje zmienną do purchasing_list zeszyt ćwiczeń.

Jednak nadal daje mi błąd 91 w części wyszukiwania i potrzebuję porady, jak mam pisać vVal2(który jest Qty) do skoroszytu listy zakupów, kolumna znajduje się tuż obok znalezionej nazwy, więc próbowałem użyć aktywnego przesunięcia komórki, ale nie działałem też

każda rada jest doceniana dzięki

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

Odpowiedzi:

1 dla odpowiedzi № 1

Podczas korzystania z Find Funkcja ta jest zalecana, jeśli ustawisz opcję Range obiekt do Find wynik, a także przygotuj swój kod dla tego scenariusza Find nie znalazłem vVal1 w "Purchasing List.xls" zeszyt ćwiczeń. Możesz to osiągnąć, korzystając z poniższej linii If Not FindRng Is Nothing Then.

Uwaga: Unikaj używania Select, Activate i ActiveSheet, zamiast tego w pełni zakwalifikuj wszystkie swoje Obiekty - zobacz w moim kodzie poniżej (z komentarzami).

Zmodyfikowany kod

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

1 dla odpowiedzi nr 2

Edytowane aby uwzględnić komentarz OP o tym, gdzie szukać i pisać wartości

ShaiRado już ci powiedział, gdzie jest ta wada

tutaj jest alternatywny kod

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