将数据从一个电子表格移动到另一个电子表格

Question

背景:我对VBA比较陌生，但我看到了使用技能集变得更舒适的价值。

目标:将无组织的数据(srce)从一个电子表格移动到另一个更结构化的电子表格(dest)中，该电子表格稍后可以上传到软件应用程序中。我有大约500个这样的电子表格需要迁移，所以通过自动化可以节省大量的时间。

Data:数据是卡车维修的历史记录。定期保养全年发生与多个服务通常在一个常规维护。在每次例行维护下，都有一个日期，车辆进行维护的小时数，以及执行的服务类型(一致列&;a &;)。

数据结构:所有的服务类型都包含在a列中。D，我有2021年所有服务执行的日期，从C11到C34。在维修时车辆运行的小时数包含在单元格D11:D34中。随后，在E和f列中包含2022年每次维护的日期和小时数。

挑战:在移动到下一列之前，我需要:

1. 检查重复日期
2. 复制该日期执行的服务类型
3. 将我的目标电子表格中从T列开始到Y列结束的所有服务粘贴在单行项目下执行的所有服务(如果在单个维护例程下执行了~8个服务)

问题:如何在不重复条目的情况下完成上述挑战，并将在同一日期执行的所有服务保持在我的电子表格中的一行内?

下面是我到目前为止的代码(我在这一节留下了一个注释，我打算在这里回答我的困境):

Sub VehicleDataExport()
Application.ScreenUpdating = False
'Set reference cell for output called "dest"
Set dest = Sheets("Dest").Range("A2")
'Initialize counter for destination for how many rows down we are so far
dindx = 0
'Set reference cell for source data called "srce"
Set srce = Sheets("Srce").Range("C11")
'Set reference cell for source for how many columns over we are
cindx = 0
'Set the service type index
Set serviceindex = Sheets("Srce").Range("A11")
'Collect name, vin, and in-service date
vehicle_name = Sheets("Srce").Range("A1")
vehicle_vin = Sheets("Srce").Range("B7")
started_at = Sheets("Srce").Range("B8")
'Go over from anchor column while not empty
While srce.Offset(-1, cindx) <> ""
'set row index so that it can restart everytime you switch columns
rindx = 0

'Cycle down through rows until an "DATE" is found
While srce.Offset(rindx, cindx) <> "DATE"

'Set counter for duplicate index so the program will move through the data while looking for duplicate DATES
duplicateindx = 0

'If statement to determine if something is in the cell - 2nd header row
If srce.Offset(rindx, cindx) > 0 Then

'True Case: copy the date, hours, and service type
service_date = srce.Offset(rindx, cindx)
service_hours = srce.Offset(rindx, cindx + 1)
service_type = serviceindex.Offset(rindx, 0)
meter_void = ""

'Properly label and account for Dot Inspection
If service_type = "DOT Inspection" Then

service_hours = 0
meter_void = True
'secondary_meter_value needs to be 0
'secondary_meter_void needs true

End If

'CHECK FOR DUPLICATE DATES AND COPY THEM TO A SINGLE ROW IN THE DESTINATION

'Paste all of the numbers into a destination row
dest.Offset(dindx, 0) = vehicle_name
dest.Offset(dindx, 1) = vehicle_vin
dest.Offset(dindx, 2) = started_at
'Variable inputs
dest.Offset(dindx, 3) = service_date
dest.Offset(dindx, 13) = service_hours
dest.Offset(dindx, 17) = service_type
dest.Offset(dindx, 14) = meter_void

'Add to both the row and destination indexes
rindx = rindx + 1
dindx = dindx + 1

'If no inspection is found, move down one row
Else: rindx = rindx + 1

'End if statement
End If

'end column specific while loop
Wend

'add two to the column index - account for both the date and hours column
cindx = cindx + 2

'End the initial while loop
Wend

Application.ScreenUpdating = True
End Sub

Answer 1

这听起来真的像是PowerQuery的工作，但如果我要用VBA来解决它，我会使用Scripting.Dictionary。我还会写一个小的数据类，其中包括所有的服务类型布尔值。

我不完全理解你的数据结构，但是一些伪代码可能看起来像这样:

Const SRVCECOL As Long = 1
Const HOURSCOL As Long = 2
Function ExtractTransformServiceData(src As Workbook) As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim svcDates As Range
Set svcDates = src.Sheets(1).Range("C11:C34")
Dim svcDate As Range
For Each svcDate in svcDates
Dim tsd As TruckServiceData
If dict.Exists(svcDate.Value) Then
Set tsd = dict.Item(svcDate.Value)
Else
Set tsd = New TruckServiceData
dict.Add svcDate.Value, tsd
End If
tsd.SetHoursForService( _
svcDate.Offset(0, SRVCECOL).Value, _
svcDate.Offset(0, HOURSCOL).Value)
Next svcDate
Set ExtractTransformServiceData = dict
End Sub