从不同的工作表中提取数据并传输到主报告

Question

伙计们，我的代码卡住了（如果不工作，数组部分）。我将不胜感激。

我有 6 个工作表（JAN、FEB、MAR、APR、MAY、JUN 和报告）。JAN-JUN 工作表包含员工缺勤记录。

我需要将 JAN-JUN 工作表中的记录（员工姓名顺序不正确）粘贴到名为“报告”的主工作表中（所有名称均按升序排列）

在报告中，我在单元格 B1、C1、D1、E1、F1、G1 中有以下标题（JAN、FEB、MAR .......JUN）。

每个工作表中的范围（“I”）包含给定月份的员工缺勤总数。

每个工作表中的 Range("H") 包含当月缺勤的员工。 我只需要从每个工作表中传输 Range("I") 并根据相关月份和员工进行粘贴。

我的代码包含来自主工作表的单元格 B1 到 G1 的数组。

Sub transferABS1()
    Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
    Dim myname As String
    Dim arRng() As Variant
    Dim iRw As Integer
    Dim iCol As Integer

    arRng = Sheets("Reports").Range("B1:G1")
    For iRw = 1 To UBound(arRng, 1)
        For iCol = 1 To UBound(arRng, 2)
            lastrow1 = Sheets(arRng).Range("H" & Rows.Count).End(xlUp).Row
            For i = 1 To lastrow1
                myname = Sheets(arRng).Cells(i, "H").Value
                Sheets("Reports").Activate
                lastrow2 = Sheets("Reports").Range("A" & Rows.Count).End(xlUp).Row
                For j = 2 To lastrow2
                    If Sheets("Reports").Cells(j, "A").Value = myname Then
                    Sheets(arRng).Activate
                    Sheets(arRng).Range(Cells(i, "I")).Copy
                    Sheets("Reports").Activate
                    ActiveSheet.Cells(j, iCol).Select
                    ActiveSheet.Paste
                    End If
                Next j
                Application.CutCopyMode = False
            Next i
        Next iCol
    Next iRw
 End Sub

Answer 1

如果您只是创建了一个包含名称/月份/小时标题的起始表，这可能会容易得多。从那里您可以运行数据透视表或各种分析。

获取表格格式比您的二维名称按月份格式更容易。此代码将列出您的报告表上的所有值。

Sub listAllNamesMonthsAndAmounts()
Const theMonths As String = "Jan,Feb,Mar,Apr,May,Jun,Jul,"
Dim ws As Worksheet, i As Long, g As Long, aCell As Range

g = 1
ReDim eList(1 To 3, 1 To g) As Variant
For Each ws In ThisWorkbook.Worksheets
    If InStr(1, theMonths, ws.Name & ",", vbTextCompare) > 0 Then
        For Each aCell In Intersect(ws.Range("H:H"), ws.UsedRange)
            If aCell <> "" Then
                ReDim Preserve eList(1 To 3, 1 To g)
                eList(1, g) = ws.Name
                eList(2, g) = aCell.Value
                eList(3, g) = aCell.Offset(0, 1).Value
                g = g + 1
            End If
        Next aCell
    End If
Next ws

Sheets("Report").Range("A2").Resize(UBound(eList, 2), UBound(eList)).Value = Application.WorksheetFunction.Transpose(eList)

End Sub