我想将数据从多个工作表/选项卡复制到主工作表

Question

我拥有的是一个包含 100 多个选项卡的电子表格，这些选项卡具有相对相同的数据格式，但有些工作表的行数比其他工作表多或少。我有一张名为 EMP_NUM 的表格，其中包含所有员工编号和姓名。我有一个 Master 表，我希望将所有相关数据复制到 Master 表中。工作表 EMP_NUM 上列出的员工编号与 100 多张工作表的名称相匹配。最后，我希望 Master 表上的每一行都有第一个单元格作为员工编号，然后该行中剩余的单元格是从所有其他表中收集的数据。

employee#工作表需要复制的数据从 A4 开始，到 TX 结束，其中 X 等于 A 列中仍有值的最大行号。

我正在考虑使用要在过程中调用的 EMP_NUM 中的数据来找到复制数据的正确工作表，因为它们会匹配，但也可以用作行。

完成后，我可以添加公式来计算数据。自从我在 Excel 中涉足 VB 中的一点点以来，已经 6 年多了，我不知道该怎么做。感谢大家的帮助！！如果我需要清理任何东西，请告诉我。

**添加**

我想第一步是找到要从中复制数据的第一张工作表。要找到第一个工作表，该函数应该转到 EMP_NUM 工作表并查看第一个数字是什么，该数字与我们想要的工作表的名称完全相关。可以是 intEmpNum

然后在相应的工作表上，我计算出第 4 行之后有多少行有数据。这些行将是要复制的范围。将此范围复制到工作表 Master 上的第一个可用行，从 B 列开始，暂时将 A 列留空。 A 列用于 intEmpNum 用于在 B 列中包含数据但在 A 列中没有数据的所有行。

然后在 EMP_NUM 上找到下一个员工编号并重复该过程，直到工作表 Emp_NUM

的 A 列中没有更多员工编号

这是我目前所拥有的 -

Sub Button1_Click()    
Dim intEmpNum As Integer 'employee number
    Dim strEmpCell As String 'row that employee number is in 
    strEmpCell = 1
    Do Until Sheets("EMP_NUM").Range("A" + strEmpCell).Value = 0
        intEmpNum = Sheets("EMP_NUM").Range("A" + strEmpCell).Value
        strEmpCell = strEmpCell + 1
    Loop
        MsgBox ("The value was not found!")
End Sub

Answer 1

我认为您对目前所拥有的代码的想法是正确的。但我会考虑使用动态范围名称来设置员工编号列表。所以你可能有一个范围名。

使用以下公式创建一个名为“EmployeeNum”的新范围

=OFFSET("EMP_NUM!$A1",0,0,COUNTA("EMP_NUM!$A:$A"),1)

这使得循环代码更容易处理

Sub getEmployeeData()
    Dim rCell As Range
    Dim dblPasteRow As Double

    'Start pasting in first row

    For Each rCell In Range("EmployeeNum")
        dblPasteRow = dblPasteRow + CopyData(rCell.Value, dblPasteRow)
    Next rCell
End Sub

我正在使用一个函数来进行复制。首先，它将代码分成您需要的两个小作业。其次，函数可以返回数据，这样我们就可以让调用子知道我们粘贴了多少行数据。

Function CopyData(strEmpNum As String, dblPasteStart As Double) As Double

    Dim wksEmployee As Worksheet
    Dim dblEndRow As Double

    'If there is an error, we are adding 0 rows
    CopyData = 0
    'Error handling - if sheet isn't found
    On Error GoTo Err_NoSheetFound
    'Set a worksheet object to hold the employee data sheet
    Set wksEmployee = Sheets(strEmpNum)
    On Error GoTo 0

    With wksEmployee
        'Find the last row on the worksheet that has data in column A
        dblEndRow = .Range("A4").End(xlDown).Row
        'Copy data from this sheet
        Range(.Range("A4"), .Range("T" & dblEndRow)).Copy
    End With

    'Paste data to master sheet - offset to column B
    Range(Worksheets("MASTER").Range("B" & dblPasteStart), Worksheets("MASTER").Range("U" & dblPasteStart + dblEndRow)).Paste
    'Write employee numbers next to the data
    Range(Worksheets("MASTER").Range("A" & dblPasteStart), Worksheets("MASTER").Range("A" & dblPasteStart + dblRowEnd)).Value = strEmpNum

    'Let the calling sub know how many rows we added
    CopyData = dblEndRow

    Exit Function
'Only runs if an error is found
Err_NoSheetFound:
    Debug.Print "Can't find employee number: " & strEmpNum

End Function

我还没有运行代码，所以其中可能存在一些错误。我希望它至少为您指明了正确的方向。

Answer 2

我最近为一次性项目选择了 VBA。将您的工作拆分为更小的任务。

这是在工作表 wn 上找到给定 NAME 的方法：

Dim wn as String
Dim COLUMN_WHERE_ID_IS as String

COLUMN_WHERE_ID_IS = "B" 
For srow = 1 To Worksheets(wn).Range("B65536").End(xlUp).row
 If (Worksheets(wn).Range(COLUMN_WHERE_ID_IS & srow & ":" & COLUMN_WHERE_ID_IS & srow).Value = NAME) Then
     '' copy stuff to target you have range now
 Exit For
End If
Next srow

现在创建一个函数，它将遍历所有单元格并检索 NAME，然后调用上面的子程序。然后你需要找到如何循环遍历所有工作表。

请注意，它非常无效。从算法的角度来看，您应该将所有 EMP NUM 放入 Set 结构中，并在检查任何工作表期间检查 set.contains(_empnum)。