如何根據從多個工作簿特定的單元格的值數據複製到主簿

Question

我已經有一個問題，我需要基於一組特定的值（幾個名稱）從2個工作簿中的數據複製到一個高手在第3列中。我是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 +記錄，所以我關心性能。我真的很感激幫助。謝謝。最簡單的方法進行可能會使用INSTR（）方法來確定電池值是否具有你是一個名字：您正在處理一個固定的名稱（即2-3）的

Answer 1

假設尋找。

如果你正在處理，你也可以只通過爲每一行檢查名稱的集合（或陣列）重複名稱的大名單。下面的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