VBA 脚本将数据从一张表汇总到另一张表

Question

目前我有一个在Excel中汇总数据的案例，Sheet1（作为源）中有数据，我需要将其复制并汇总这些数据到Sheet2（作为目标），目标工作表有自己的标题。我有更好的视角的例子。

源数据（表1）

目标数据（表2）

由于我没有任何VBA经验， 你能帮我解决这个难题吗？

非常感谢您的帮助，谢谢。

问候

马德鲁克

Answer 1

这是一个 VBA 脚本，用于将第一个工作表（源）中的数据汇总为第二个工作表（目标）中的汇总格式。该脚本将：

1.循环遍历源工作表（Sheet1）中的行。 2.根据您指定的目标格式汇总数据。 3.将汇总数据粘贴到目标表（Sheet2）中。

子汇总数据() Dim wsSource 作为工作表，wsTarget 作为工作表 调暗最后行一样长，目标行一样长 Dim empID 作为字符串，名称作为字符串，dateIn 作为字符串 Dim timeIn 作为字符串，timeOut 作为字符串，timeOff 作为 Double 昏暗的时间为双精度，日期为字符串，描述为字符串 Dim ota 作为字符串，travelAllowance 作为字符串，projectNumber 作为字符串

' Set worksheets
Set wsSource = ThisWorkbook.Sheets("Sheet1")
Set wsTarget = ThisWorkbook.Sheets("Sheet2")

' Get the last row of the source data
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Start row for the target sheet
targetRow = 2 ' Assuming row 1 is the header in the target sheet

' Loop through each row in the source sheet
Dim i As Long
For i = 2 To lastRow
    ' Read data from source sheet
    empID = wsSource.Cells(i, 4).Value
    name = wsSource.Cells(i, 5).Value
    dateIn = wsSource.Cells(i, 1).Value
    timeIn = wsSource.Cells(i, 6).Value
    timeOut = wsSource.Cells(i, 7).Value
    timeOff = wsSource.Cells(i, 8).Value
    hours = wsSource.Cells(i, 9).Value
    day = wsSource.Cells(i, 11).Value
    description = wsSource.Cells(i, 12).Value
    ota = wsSource.Cells(i, 13).Value
    travelAllowance = wsSource.Cells(i, 14).Value
    projectNumber = Split(wsSource.Cells(i, 2).Value, ".")(0) ' Extract project number

    ' Write summarized data to target sheet
    wsTarget.Cells(targetRow, 1).Value = empID
    wsTarget.Cells(targetRow, 2).Value = name
    wsTarget.Cells(targetRow, 3).Value = dateIn
    wsTarget.Cells(targetRow, 4).Value = timeIn
    wsTarget.Cells(targetRow, 5).Value = timeOut
    wsTarget.Cells(targetRow, 6).Value = timeOff
    wsTarget.Cells(targetRow, 7).Value = hours
    wsTarget.Cells(targetRow, 8).Value = day
    wsTarget.Cells(targetRow, 9).Value = description
    wsTarget.Cells(targetRow, 10).Value = ota
    wsTarget.Cells(targetRow, 11).Value = travelAllowance
    wsTarget.Cells(targetRow, 12).Value = projectNumber

    ' Increment the target row
    targetRow = targetRow + 1
Next i

MsgBox "Data summarization complete!"

结束子

使用说明： 1.打开 Excel 工作簿。 2.按 Alt + F11 打开 VBA 编辑器。 3.在VBA编辑器中，单击插入>模块添加新模块。 4.将上述脚本粘贴到模块中。 5.关闭VBA编辑器并返回Excel。 6.按 Alt + F8，选择 SummarizeData，然后单击运行。