複数のワークブックの特定のセル値に基づいてデータをマスターワークブックにコピーする方法

Question

2つのワークブックのデータを特定の値のセット（複数の名前）に基づいてマスターにコピーする必要があるという問題があります。私はVBAを初めて使いました。おそらく私は正確に答えを見つけるために質問することはできません。あなたが私を助けてください、私は各ブックからデータの行を引き出す必要があります私は探している名前が含まれている場合は、列3が含まれている場合。私は特定のフォルダ内のすべてのブックからデータを引き出すために以下のコードを持っていますが、絶対にすべてを取得します。

Sub copyDataFromManyFiles() 

With Application 
    .DisplayAlerts = False 
    .EnableEvents = False 
    .ScreenUpdating = False 
End With 

Dim FolderPath As String, FilePath As String, FileName As String 

FolderPath = "C:\Users\Jasiek\Desktop\Yuuuge MacroTest\" 
FilePath = FolderPath & "*ennik*.xl*" 
FileName = Dir(FilePath) 

Dim lastrow As Long, lastcolumn As Long 

Do While FileName <> "" 
Workbooks.Open (FolderPath & FileName) 

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy 
Application.DisplayAlerts = False 
ActiveWorkbook.Close 

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets(1).Range(Cells(erow, 1), Cells(erow, 30)) 

FileName = Dir 

Loop 

With Application 
    .DisplayAlerts = True 
    .EnableEvents = True 
    .ScreenUpdating = True 
End With 

'Call removeDuplicates 

End Sub 

行をコピーする前にコードを変更してデータをフィルタする必要がありますか？ 100k +のレコードがあるので、私はパフォーマンスについて気にします。私は本当に助けに感謝します。ありがとう。

Answer 1

固定された名前（つまり：2-3）を扱っていると仮定すると、最も簡単な方法は、おそらくinstr（）メソッドを使用して、セルの値があなたの名前探している。

名前の大きいリストを扱っている場合は、各行チェックの名前のコレクション（または配列）を反復することもできます。以下のinstr（）メソッドは、調べている文字列から検索された文字列の整数位置を返します。何かが見つかった場合は、その位置に対して0より大きい値が返されます（例：位置1は一致する部分が最小値です）。 vbTextCompareオプションは、比較（大文字小文字の不一致）と同じように大文字と小文字を区別しないようにするだけです。

私はワークシートとワークブックを明示的に参照して、きれいで具体的なものであることを保証しますが、ActiveWorkbookやActiveWorksheetを使用することができます。

一時的な文字列変数に各セルの値を格納し、tempStr文字列との比較を実行すると、毎回セルの値を参照するのに比べて取得時間が節約されます。 x名の各行のx比較チェックのための完全な実行）。

Option Compare Text 

Option Explicit 

Public Sub start() 
    Dim foundBool As Boolean 
    Dim oxl As Excel.Application 
    Dim wb1 As Excel.Workbook 

    Dim tempName1 As String 
    Dim tempName2 As String 

    Dim tempStr1 As String 
    Dim tempStr2 As String 
    Dim tempInt1 As Integer 
    Dim tempInt2 As Integer 

    Set oxl = New Excel.Application 

    Set wb1 = oxl.Workbooks().Open("[path here]\Book1.xlsm") 

    wb1.Activate 

    'ActiveWorkbook.Worksheets ("") can also possibly be used 
    'if needed in lieu of a oxl and wb1 declaration, or perhaps 
    'even ActiveSheet. 

    'cells().value provides the apparent value of the cell taking formatting into account. Applies to things like dates 
    'or currencies where the underlying value might be different than what's shown. 
    tempStr1 = CStr(wb1.Worksheets("Sheet1").Cells(1, 1).Value) 
    tempName1 = "John" 

    'cells().value2 provides the underlying actual value of the cell (i.e.: without any formatting or interperetation). 
    'if you deal a lot with dates/currencies and don't want excel formatting to get between you and the source 
    'data use this one. Used here only to show the two different options 
    tempStr2 = CStr(wb1.Worksheets("Sheet1").Cells(2, 1).Value2) '<---next row's value 
    tempName2 = "Peter" 


    tempInt1 = InStr(1, tempStr1, tempName1, vbTextCompare) 
    tempInt2 = InStr(1, tempStr1, tempName2, vbTextCompare) 

    If tempInt1 > 0 Or _ 
     tempInt2 > 0 Then 

     foundBool = True 

    End If 

    wb1.Close 
    oxl.Quit 
    Set wb1 = Nothing 
    Set oxl = Nothing 

End Sub