时间戳

首页 > 解决方案 > 如何使用员工 ID 作为标识符将多个工作表中的数据复制到一个工作表中

excel - 如何使用员工 ID 作为标识符将多个工作表中的数据复制到一个工作表中

问题描述

我对 Excel 和宏很陌生。

我有一个文件，其中员工数据分散在同一个文件中的多个工作表中。我想在以“数据源 1”表开头的每个表中搜索员工编号，并将每行中的所有数据与员工 ID 复制到“组合数据”表中。

接下来，我想在工作表“数据源 2”中搜索相同的员工 ID，并将信息复制到指定列中的“组合工作表”，如果信息不可用，则在“数据源 3”中搜索相同的员工 ID，并将数据复制到组合仅在指定列中再次工作表。

如果它不存在，则再次循环从“数据源 1”表中搜索新员工 ID 开始。

我被卡住了，无法理解如何继续前进。

当前使用的代码：

Sub Search_cell()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    
    On Error GoTo Err_Execute
    
    'Start search in row 3
    LSearchRow = 3
    
    'Start copying data to row 2 in Sheet Combined_data (row counter variable)
    LCopyToRow = 2
    
    Sheets("Data source 1").Select
    
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
    
       'If value in column A = "123", copy entire row to sheet Combined_data
       If Range("A" & CStr(LSearchRow)).Value = "123" Then
    
          'Select row in Sheet Data Source 1 to copy
          Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
          Selection.Copy
    
          'Paste row into Sheet Combined_data in next row
          Sheets("Combined_data").Select
          Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
          ActiveSheet.Paste
    
          'Move counter to next row
          LCopyToRow = LCopyToRow + 1
    
          'Go back to Sheet1 to continue searching
          Sheets("Data source 1").Select
    
       End If
    
       LSearchRow = LSearchRow + 1
    
    Wend
    
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    
    MsgBox "All matching data has been copied."
    
    Exit Sub
    
Err_Execute:
    MsgBox "An error occurred."
    
    
End Sub

问题 ：

  1. 我必须手动提供要搜索的 Ideantifier 示例“123”，我希望它直接通过转到工作表“数据源 1”中的下一行来获取

  2. 此代码复制并粘贴发生匹配的整行数据，而不是将数据从工作表“数据源 2”粘贴到“Combined_data”工作表中的 E 列到 H 列。

  3. 我不明白如何为工作表数据源 2、数据源 3 复制相同的过程。

标签： excelvba

解决方案

请尝试以下代码。

还将您的工作表名称从“日期源 1”更正为“数据源 1”

Sub CombineData()
    
    Dim dataRng1 As Range, dataRng2 As Range, dataRng3 As Range
    Dim searchRng As Range, lrow As Long, combRng As Range
        
        Set dataRng1 = Worksheets("Data source 1").Range("A3", Worksheets("Data source 1").Range("D" & Rows.Count).End(xlUp))
        Set dataRng2 = Worksheets("Data source 2").Range("A3", Worksheets("Data source 2").Range("E" & Rows.Count).End(xlUp))
        Set dataRng3 = Worksheets("Data source 3").Range("A3", Worksheets("Data source 3").Range("D" & Rows.Count).End(xlUp))
        
        lrow = Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row
        
        Set searchRng = Worksheets("Combined").Range("A2", Worksheets("Combined").Range("A2").End(xlDown))
        Set combRng = Worksheets("Combined").Range("A3", Worksheets("Combined").Range("K" & lrow))
        
        combRng.Cells.Clear
    
    Dim rw As Range, destRow As Long
    
        For Each rw In dataRng1.Rows
        
            rw.Copy Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            
        Next rw
        
        For Each rw In dataRng2.Rows
            
            If Not searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole) Is Nothing Then
                destRow = searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole).Row
                rw.Offset(0, 1).Resize(, rw.Columns.Count - 1).Copy Worksheets("Combined").Range("E" & destRow, "H" & destRow)
            End If
            
        Next rw
        
        For Each rw In dataRng3.Rows
        
            If Not searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole) Is Nothing Then
                destRow = searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole).Row
                rw.Offset(0, 1).Resize(, rw.Columns.Count - 1).Copy Worksheets("Combined").Range("I" & destRow, "K" & destRow)
            End If
            
        Next rw
    
End Sub

推荐阅读