Excel VBAmacros报告从两张单独的工作表
嗨，我有一个问题，我正在尝试用Excel和VBA /macros来解决问题，我有1张有客户数据和公司为客户工作的小时数。 我已经创build了一个vba，它只创build一个工作表，其中只有工作时间为+40小时的客户端。
例：
客户——客户ID —小时
客户2 —— 6465 ——– 46
客户5 —— 4873 ——– 48
客户8 —— 6578 ——– 64
另一张表是在这些客户上工作的员工的细目，以及每个员工login多less个小时。 （已经按ClientID排列）
客户ID ——员工——小时
6465 ———— ———-琼20
6465 ———— ———-卡尔20
6465 ———— ——–苏珊6
4873 ———– ———比尔15
4873 ———–内特——— 15
4873 ———– ———-吉姆10
4873 ———– ———琼8
5555 ———– ———-仁8
5555 ———– ———-丹8
4223 ———–安迪——— 12
4223 ———– ———卡尔4
（包括为客户工作的员工总共不到40小时）
注意客户6465的员工如何工作20小时，20小时和6小时，总共46（如第一张表中的总数），但是对于客户4223，只有2名员工安迪和卡尔工作了12和4小时，这是16这就是为什么clientID不出现在上面显示的第一张表。
我需要做的是在第一张表中使用clientID的macros，并在第二张表中find这些客户端ID，并创build一个新的表格，只与那些带有员工姓名和第一张表的小时数的客户端ID有关，因为客户端太多第二张表中的ID，因为它包含所有的客户端ID和员工。 基本上我需要筛选出一堆不超过40小时的客户端ID，但是由于第一张表格已经显示出我的客户端ID是+40，所以我只需要在client端查找它们由clientID已经安排的工作表。 对不起，如果这是混淆让我知道如果有反正它可以做到。 我猜测必须有一个循环，检查每个细胞的特定clientID，并复制所有这些clientID的，并转移到下一个。
因此，对于采用ClientID和小时工作的代码的第一部分，只显示40小时以上的代码，我使用这个
Cells.Select Selection.AutoFilter ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=">40", _ Operator:=xlAnd ActiveSheet.UsedRange.Copy Destination:=ActiveWorkbook.Sheets("Sheet2").Range("A1") Selection.AutoFilter 这段代码基本上只用了40多个小时的clientID，并把它们放到另一个表中。 现在我需要采取新的工作表，并抓住每个客户端的ID，并find那些客户端在另一个工作表的雇员在每个客户端上工作与他们的小时数有关的客户端ID …这是我没有任何线索如何做，因为它是在两个不同的工作表上
新的编辑
好吧，现在我有更多的代码..下面的代码可以帮助我将两张表合并到一张表中…现在我所需要的只是某种循环，它只检查第一张表中的那些ClientID，并只拷贝那些相同的clientID第二张到新的组合表。 不知何故，必须在这个代码里面
Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub CopyRangeFromMultiWorksheets() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range With Application .ScreenUpdating = False .EnableEvents = False End With ' Delete the summary sheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a new summary worksheet. Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then ' Find the last row with data on the summary worksheet. Last = LastRow(DestSh) ' Specify the range to place the data. Set CopyRng = sh.Range("A1:D15") ' Test to see whether there are enough rows in the summary ' worksheet to copy all the data. If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the " & _ "summary worksheet to place the data." GoTo ExitTheSub End If ' This statement copies values and formats from each ' worksheet. CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With ' Optional: This statement will copy the sheet ' name in the H column. DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto DestSh.Cells(1) ' AutoFit the column width in the summary sheet. DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
此代码将遍历您的雇员表中的所有行，在总工时表中查找客户端ID，并在每个员工行旁边的Col D中返回“超过40”或“低于40”。 那么这只是一个简单的filter（你已经知道如何编码）。
Sub CopyIt() 'Assumes ClientID is Col A, Employee is Col B, and Hours is Col C on SourceSht 'Assumes Client is Col A, ClientID is Col B, and Hours is Col C on HoursSht Dim LastRow As Long, CurRow As Long, SourceSht As Worksheet, OverF As Worksheet, CCell As Range Set SourceSht = Sheets("Name of Sheet with Employees") Set HoursSht = Sheets("Name of Sheet with your Hours per Client") 'Do original one not the over 40 one LastRow = SourceSht.Range("A" & Rows.Count).End(xlUp).Row For CurRow = 2 To LastRow If Not HoursSht.Range("B:B").Find(SourceSht.Range("A" & CurRow).Value, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then Set CCell = HoursSht.Range("B:B").Find(SourceSht.Range("A" & CurRow).Value, LookIn:=xlValues, LookAt:=xlPart) If CCell.Offset(0, 1).Value > 40 Then SourceSht.Range("D" & CurRow).Value = "Over 40" Else SourceSht.Range("D" & CurRow).Value = "Less than or equal to 40" End If Else SourceSht.Range("D" & CurRow).Value = "Client ID Not Found" End If Next CurRow Cells.Select Selection.AutoFilter ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:="Over 40", _ Operator:=xlAnd ActiveSheet.UsedRange.Copy Destination:=ActiveWorkbook.Sheets("Sheet3").Range("A1") Selection.AutoFilter End Sub