VBA龐大的數據總結

Question

我一直在尋找和做這個任務幾周，但從來沒有找到一個解決方案。 我希望你們可以給我一個解決方案。

我的條件如下：
1.我有2個Excel工作簿
（第一：Log.xlsx - 彙總數據，
第二：data.xls - 數據源）
2.在日誌.xlsx，我有生產日期，產品ID和批號＃
3.在data.xls中，我有生產良品率結果（不同工作表針對不同ID）
FYI，工作表編號大約爲100工作表
4. I要在同一日期，產品ID和批號＃（與Log.xlsx中的
匹配）搜索良率結果（data.xls），然後顯示產量結果Log.xlsx
5. data.xls工作表名稱是從產品ID不同，但實際的產品ID在
B2單元格中顯示

你能告訴我如何實現這一目標？
真的很感謝你的幫助。

謝謝。

Answer 1

假設代碼是在log.xlsx，和這兩個工作簿當前打開，這將通過複製7立柱4從data.xls到log.xlsx

Option Explicit 

Public Sub DataSummary() 
Dim wbData As Workbook 
Dim wsLog As Worksheet 
Dim wsDataSet As Worksheet 
Dim i, j, k As Integer 
Dim prodDate As Date 
Dim prodID As String 
Dim lotNumber As Integer 

Set wbData = Workbooks("Data.xls") 
Set wsLog = ThisWorkbook.ActiveSheet 

For i = 2 To wsLog.UsedRange.Rows.Count 
    prodDate = wsLog.Cells(i, 1).Value 
    prodID = wsLog.Cells(i, 2).Value 
    lotNumber = wsLog.Cells(i, 3).Value 
    For Each wsDataSet In wbData.Worksheets 
     If wsDataSet.Cells(2, 2).Value = prodID Then 
      For j = 4 To wsDataSet.UsedRange.Rows.Count 
       If wsDataSet.Cells(j, 1).Value = prodDate And wsDataSet.Cells(j, 3).Value = lotNumber Then 
        wsLog.Cells(i, 4).Value = wsDataSet.Cells(j, 4).Value 
        wsLog.Cells(i, 5).Value = wsDataSet.Cells(j, 5).Value 
        wsLog.Cells(i, 6).Value = wsDataSet.Cells(j, 6).Value 
        wsLog.Cells(i, 7).Value = wsDataSet.Cells(j, 7).Value 
        Exit For 
       End If 
      Next j 
      Exit For 
     End If 
    Next wsDataSet 

Next i 

End Sub 

Here is link to excel files with code and sample data.

下面是代碼與額外的檢查。當沒有匹配的時候，它將「0」放入。

Option Explicit 

Public Sub DataSummary() 
Dim wbData As Workbook 
Dim wsLog As Worksheet 
Dim wsDataSet As Worksheet 
Dim i, j, k As Integer 
Dim prodDate As Date 
Dim prodID As String 
Dim lotNumber As Integer 
Dim foundIt As Boolean 
Dim Message As String 

Message = "0" 
Set wbData = Workbooks("Data.xls") 
Set wsLog = ThisWorkbook.ActiveSheet 

For i = 2 To wsLog.UsedRange.Rows.Count 
    foundIt = False 
    prodDate = wsLog.Cells(i, 1).Value 
    prodID = wsLog.Cells(i, 2).Value 
    lotNumber = wsLog.Cells(i, 3).Value 
    For Each wsDataSet In wbData.Worksheets 
     If wsDataSet.Cells(2, 2).Value = prodID Then 
      For j = 4 To wsDataSet.UsedRange.Rows.Count 
       If wsDataSet.Cells(j, 1).Value = prodDate And wsDataSet.Cells(j, 3).Value = lotNumber Then 
        wsLog.Cells(i, 4).Value = wsDataSet.Cells(j, 4).Value 
        wsLog.Cells(i, 5).Value = wsDataSet.Cells(j, 5).Value 
        wsLog.Cells(i, 6).Value = wsDataSet.Cells(j, 6).Value 
        wsLog.Cells(i, 7).Value = wsDataSet.Cells(j, 7).Value 
        foundIt = True 
        Exit For 
       End If 
      Next j 
      Exit For 
     End If 
    Next wsDataSet 
    If Not foundIt Then 
     wsLog.Cells(i, 4).Value = Message 
     wsLog.Cells(i, 5).Value = Message 
     wsLog.Cells(i, 6).Value = Message 
     wsLog.Cells(i, 7).Value = Message 
    End If 
Next i 

End Sub 

請記住，這只是真正解決粗糙scetch，你需要添加異常處理，更多的檢查，看看數據是否正確等