查找数据的状态并跨纸张进行复印
我对VBA很新。 希望有人能帮助我。 非常感谢。
工作表1（要复制到工作表4的数据）
ABCD 1 ID Header 2 Header 3 Orders 2 5000 455,476,497 3 5012 500 4 5015 502,503 表2（数据）
ABCD ........ Q 1 Orders ID Header 2 Status Header 4 2 455 Closed 3 456 Open 4 476 Closed 5 497 Closed
表3
ABCD 1 455 476 497 2 500 3 502 503
工作表4（输出表）
ABCD 1 ID Header 2 Header 3 Orders 2 5000 455,476,497 3
任务：我需要检查表3中以下ID 455,476和497的状态。如果一行中的所有ID的状态是closures的，那么将整个行从表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
请尝试下面的代码
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
以下是结果 