查找數據並跨表單複印的狀態

Question

我對VBA很新穎。希望有人能幫助我。非常感謝。

表1（數據被拷貝到表4）

 A  B  C   D 
1 ID Header 2 Header 3 Orders 
2 5000      455,476,497 
3 5012       500 
4 5015      502,503 

表2（數據）

 A   B   C   D ........ Q 
1 Orders ID   Header 2 Status Header 4 
2 455       Closed 
3 456       Open 
4 476       Closed 
5 497       Closed 

表3

A B C D 
1 455 476 497 
2 500 
3 502 503 

表4（輸出片材）

 A  B  C   D 
1 ID Header 2 Header 3 Orders 
2 5000      455,476,497 
3 

任務：我需要檢查工作表3中以下ID 455,476和497的狀態。如果一行中所有ID的狀態已關閉，則將整個行從工作表1複製到工作表4，如果不移動到下一行。

For a = 1 To Range("A1").End(xlDown).Row 

    For b = 1 To Range("A1").End(xlToRight).Column 
     Cells(1, b).Select 

     Selection.Copy 
     Sheets("Orders").Select    

     (Unsure what to put here) 

    Next b 
Next a 

我需要更多的聲望才能在此發佈圖片。所以，張貼鏈接 （只允許2）

http://imgur.com/K8H2JhD，http://imgur.com/KjeIDVm，U0Z7mfm，qWOJ3VM

Answer 1

請嘗試下面的代碼

Sub FindStausAndCopy() 

Dim sheet1Range As Range 
Dim sheet2Range As Range 
Dim sheet3Range As Range 

Dim sheet1RowCount As Integer 
Dim sheet1ColCount As Integer 

Dim sheet2RowCount As Integer 
Dim sheet2ColCount As Integer 

Dim sheet3RowCount As Integer 
Dim sheet3ColCount As Integer 

Dim shtRowNum As Integer 
Dim totalCellsinRow As Integer 
Dim statusCount As Integer 
Dim orders As String 

Dim range1Row As Variant 
Dim range2Row As Variant 
Dim range3Row As Variant 
Dim cellVal As Variant 



sheet1RowCount = Worksheets("Sheet1").UsedRange.Rows.Count 
sheet1ColCount = Worksheets("Sheet1").UsedRange.Columns.Count 

sheet2RowCount = Worksheets("Sheet2").UsedRange.Rows.Count 
sheet2ColCount = Worksheets("Sheet2").UsedRange.Columns.Count 

sheet3RowCount = Worksheets("Sheet3").UsedRange.Rows.Count 
sheet3ColCount = Worksheets("Sheet3").UsedRange.Columns.Count 

Worksheets("sheet1").Activate 
Set sheet1Range = Worksheets("Sheet1").Range(Cells(1, 1), Cells(sheet1RowCount, sheet1ColCount)) 
Worksheets("sheet2").Activate 
Set sheet2Range = Worksheets("Sheet2").Range(Cells(1, 1), Cells(sheet2RowCount, sheet2ColCount)) 
Worksheets("sheet3").Activate 
Set sheet3Range = Worksheets("Sheet3").Range(Cells(1, 1), Cells(sheet3RowCount, sheet3ColCount)) 

shtRowNum = 1 'This is for incrementing the Row in Sheet4 
'Iterating through Each row in Sheet3 and then through 
'each cell in a particular row 
'Loop1 
For Each range3Row In sheet3Range.Rows 
totalCellsinRow = 0 ' to count no of order numbers in sheet3 rows 
statusCount = 0  ' to count the status of orders 
orders = ""   ' to store all order numbers with coma seperated 

    'Iterating throgh each Order in a row and identifing the status 
    'Loop2 
    For Each cellVal In range3Row.Cells 
    If (cellVal <> "") Then 
    totalCellsinRow = totalCellsinRow + 1 'Increments for every order 
    'Iterating through each row in sheet2 to check the status and 
    ' Increment status count 
    'Loop3 
     For Each range2Row In sheet2Range.Rows 
      If (range2Row.Cells(1) = cellVal And range2Row.Cells(4) = "Closed") Then 
      statusCount = statusCount + 1 'Increments only when order is closed 
      orders = orders & ", " & cellVal 
      End If 
     Next range2Row 
     'By the time Loop3 is completed we get the status of one order 
     End If 
    Next cellVal 
    'By the time Loop2 is completed, we get the overall status of all orders 
    ' in a row of sheet3 
    ' If statusCount = totalCellsinRow which implies every order 
    ' present in a row is closed 
    If (totalCellsinRow = statusCount) Then 
     'Lopp4: Iterating throgh each row of sheet1 to find Matching ID 
     'The reason for iterating through rows,even if the order of the ID 
     ' changes, code should be in a position to identify the right row 
     ' to copy 
     For Each range1Row In sheet1Range.Rows 
      If (range1Row.Cells(4) = Trim(Right(orders, Len(orders) - 1))) Then 
       If (shtRowNum = 1) Then 
       'Copying the Header row to sheet4 only once. 
       sheet1Range.Rows(1).Copy Destination:=Worksheets("sheet4").Cells(1, 1) 
       shtRowNum = shtRowNum + 1 
      End If 
      'Copying the row from sheet1 to sheet4 
      range1Row.Copy Destination:=Worksheets("Sheet4").Cells(shtRowNum, 1) 
      shtRowNum = shtRowNum + 1 
      End If 
     Next range1Row 
     'By the time Loop4 is completed a ID row for the closed Orders will 
     ' be copied to Sheet4 
    End If 
Next range3Row 
'By the time Loop1 is completed all the orders status will be read 
' Corresponding Id rows will be copied to sheet4 with Header row 

End Sub 

下面是結果