Question

嘿伙计们我有问题我正在尝试使用excel和VBA / Macros解决我有1张表，其中包含客户端数据以及公司为该客户端工作的小时数。我已经创建了一个vba，它创建的工作表只包含下面工作表+40小时的客户端。

示例：

客户端------客户端ID ---小时

客户2 ------ 6465 -------- 46

客户5 ------ 4873 -------- 48

客户8 ------ 6578 -------- 64

另一张表是在这些客户上工作的员工的细分以及每位员工记录的小时数。（已按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名员工Andy和Carl工作了12和4小时是16，这就是为什么clientID没有出现在上面显示的第一张表格中。

我需要做的是拥有一个宏，它在第一个工作表中使用clientID并在第二个工作表中找到那些clientID，并且只创建一个新工作表，其中包含具有员工姓名和第一个工作表小时数的clientID第二张表中的客户端ID太多，因为它包含所有clientID和员工。基本上我需要过滤掉一堆不超过40小时或更长时间的客户端ID，但由于第一张表已经告诉我哪个clientID是+40所有我需要做的就是在第二个时候通过clientID查找它们已经由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并将它们放入另一个工作表中。现在我需要获取新表并获取每个表的clientID，并在另一个工作表中找到那些ClientID，其中包含在每个客户端上工作的员工，他们的工作时间与该clientID相关...这个我没有任何线索怎么办，因为它在两张不同的纸张上

NEW EDIT

好的，所以我现在有了更多的代码..以下代码可以帮助我将两张纸合并为一张...现在我需要的是某种循环，只检查第一张纸中的那些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

Answer 1

此代码将循环遍历Employees工作表上的所有行，在总小时工作表中查找客户端ID，并在每个员工行旁边的Col D中返回“40以上”或“40岁以下”。然后它只是一个简单的过滤器（你已经知道如何编码）。

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

Excel VBA宏报告来自两个单独的工作表

1 个答案: