/ /異なるブックから検索し、値をコピーする - Excel、VB.NET、VBA、Excel-VBA

異なるブックから検索し、値をコピーする - Excel、VB.NET、VBA、Excel-VBA

私は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

回答:

回答№1は1

あなたが Find 関数を使用する場合は、 Range オブジェクトに Find 結果を確認し、コードを準備して Find 見つけられなかった vVal1"Purchasing List.xls" ワークブック。あなたは次の行を使ってそれを達成することができます If Not FindRng Is Nothing Then.

注意: 使用を避ける Select, Activate そして ActiveSheet代わりに、あなたのすべてのオブジェクトを完全に修飾します。以下の私のコードを参照してください(コメント付き)。

変更されたコード

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

回答№2の場合は1

編集済み 値を検索して書き込む場所に関する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