1

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

需要复制的员工#工作表数据从 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
4

2 回答 2

0

我最近为一次性项目选择了 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)。

于 2010-10-27T21:19:31.777 回答
0

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

使用以下公式创建一个名为“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

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

于 2010-10-29T03:49:46.870 回答