Question

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

员工＃表单需要复制的数据从A4开始，到TX结束，其中X等于columnA中仍有值的最大行号。

我正在考虑在过程中调用 EMP_NUM 中的数据来查找正确复制数据的表格，因为它们会匹配，但也可以用作第一个单元格。行。

完成后，我可以添加公式来计算数据。自从我在Excel中使用VB中的一小部分时，我已经超过6年了，而且我不知道该怎么做。感谢大家的帮助！！如果我需要清除任何内容，请告诉我。

的的 ** ** ADDED

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

然后在相应的工作表上，我弄清楚第4行有多少行有数据。这些行将是要复制的范围。将此范围复制到工作表主上的第一个可用行，从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

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

以下是如何在工作表上找到给定的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）。

Answer 2

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

使用以下公式

创建一个名为“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

我没有运行代码，因此可能存在一些错误。我希望它至少能指出你正确的方向。

我想将数据从多个工作表/标签复制到主工作表

2 个答案: