我对VB脚本非常陌生，并寻求以下列格式重组数据的帮助。
数据采用以下格式
ID Dt Var1 value1 Var2 Value2
234456 3/14/2017
234456 problem tap leakage Manufacturer abc org
234456 defect LEAKAGE Supplier xyz org
234456 remedy repaired
234456 defct_dt 3/14/2017
234456 rdy_dt 3/17/2017
234457 3/21/2017
234457 problem tap leakage Manufacturer edc org
234457 problem motor problem
234457 defect LEAKAGE
234457 defect DEFECTIVE Supplier 123 org
234457 remedy repaired
234457 defct_dt 3/21/2017
期望的输出
ID Dt problem1 Problem2 defect1 defect2 remedy1 remedy2 defect_dt remedy_dt Manufacturer Supplier
234456 3/14/2017 tap leakage LEAKAGE repaired 3/14/2017 3/17/2017 abc org xyz org
234457 3/21/2017 tap leakage motor problem LEAKAGE DEFECTIVE repaired 3/21/2017 3/25/2017 edc org 123 org
我想要每个ID一行。能帮忙吗？
由于
答案 0 :(得分：0)
您的问题遭到严重否决。我有一个尝试过的解决方案，但我不得不做出一些假设。这些假设是一个措辞更好的问题可以避免的，如果假设是错误的，那么我提供的解决方案根本不适合你。这些是我的假设：
<强>假设
标签已删除数据（适用于粘贴到Excel，工作表中的“输入”）
ID Dt Var1 value1 Var2 Value2
234456 3/14/2017
234456 problem tap leakage Manufacturer abc org
234456 defect LEAKAGE Supplier xyz org
234456 remedy repaired
234456 defct_dt 3/14/2017
234456 rdy_dt 3/17/2017
234457 3/21/2017
234457 problem tap leakage Manufacturer edc org
234457 problem motor problem
234457 defect LEAKAGE
234457 defect DEFECTIVE Supplier 123 org
234457 remedy repaired
234457 defct_dt 3/21/2017
我认为我的假设是合理的，我觉得这个问题很有意思，所以虽然SO不是代码编写服务，但我想我会试一试。以下是我提出的建议（毫无疑问，它可以更有效地完成）：
VBA代码
Sub RestructureDate()
'Input/Output Worksheets
Dim shtInput As Worksheet
Dim shtOutput As Worksheet
Set shtInput = ThisWorkbook.Sheets("Input")
Set shtOutput = ThisWorkbook.Sheets("Output")
'Clear Output Sheet
shtOutput.Cells.Clear
'Header Row Output
shtOutput.Range("A1", "L1") = Array("ID", "Dt", "problem1", "Problem2", "defect1", "defect2", "remedy1", "remedy2", "defect_dt", "remedy_dt", "Manufacturer", "Supplier")
Dim intInputRow As Integer 'Track what row we read from
Dim intOutputRow As Integer 'Track what row we write to
Dim PreviousID As String 'ID on the previous input row
Dim CurrentID As String 'ID on the current input row
'Input Column Structure
Dim arrayInputRow(6) As String
Dim colInputID As Integer
Dim colInputDate As Integer
Dim colInputVar1 As Integer
Dim colInputValue1 As Integer
Dim colInputVar2 As Integer
Dim colInputValue2 As Integer
colInputID = 0
colInputDate = 1
colInputVar1 = 2
colInputValue1 = 3
colInputVar2 = 4
colInputValue2 = 5
'Output Column Structure
Dim arrayOutputRow(12) As String
Dim colID As Integer
Dim colDt As Integer
Dim colProblem1 As Integer
Dim colProblem2 As Integer
Dim colDefect1 As Integer
Dim colDefect2 As Integer
Dim colRemedy1 As Integer
Dim colRemedy2 As Integer
Dim colDefectDt As Integer
Dim colRemedyDt As Integer
Dim colManufacturer As Integer
Dim colSupplier As Integer
colID = 0
colDt = 1
colProblem1 = 2
colProblem2 = 3
colDefect1 = 4
colDefect2 = 5
colRemedy1 = 6
colRemedy2 = 7
colDefectDt = 8
colRemedyDt = 9
colManufacturer = 10
colSupplier = 11
'Start on the second row of each
intInputRow = 2
intOutputRow = 2
'Initialise IDs
CurrentID = ""
PreviousID = ""
'We output when we reach the start of the next ID, so need to carry on one row further than you would expect
'Carry on until "previous" row is blank
While shtInput.Cells(intInputRow - 1, 1).Text <> ""
'ID Looked at in Previous Loop
PreviousID = CurrentID
'Read Input Row
For i = 0 To 5
arrayInputRow(i) = shtInput.Cells(intInputRow, i + 1).Text
Next i
'Get ID
CurrentID = arrayInputRow(colInputID)
'No More Stuff for Previous ID, So Output What We've Got
If PreviousID <> "" And PreviousID <> CurrentID Then 'No More Stuff
shtOutput.Range("A" & intOutputRow, "L" & intOutputRow) = arrayOutputRow 'Output
intOutputRow = intOutputRow + 1 'Move to Next Output Row
End If
'Set Output ID
arrayOutputRow(colID) = CurrentID
'Set Date (only where available)
If arrayInputRow(colInputDate) <> "" Then arrayOutputRow(colDt) = arrayInputRow(colInputDate)
'Get Other Stuff
If CurrentID = PreviousID Then 'While it's the same ID
Select Case arrayInputRow(colInputVar1) 'Check Var1
Case "problem" 'If Problem
If arrayOutputRow(colProblem1) = "" Then 'And Problem1 not used
arrayOutputRow(colProblem1) = arrayInputRow(colInputValue1) 'Assign Val1 to Problem1
Else
arrayOutputRow(colProblem2) = arrayInputRow(colInputValue1) 'Else Assign to Problem2
End If
Case "defect" 'If Defect
If arrayOutputRow(colDefect1) = "" Then 'And Defect1 not used
arrayOutputRow(colDefect1) = arrayInputRow(colInputValue1) 'Assign Val1 to Defect1
Else
arrayOutputRow(colDefect2) = arrayInputRow(colInputValue1) 'Else Assign to Defect2
End If
Case "remedy" 'If Remedy
If arrayOutputRow(colRemedy1) = "" Then 'And Remedy1 not used
arrayOutputRow(colRemedy1) = arrayInputRow(colInputValue1) 'Assign Val1 to Remedy1
Else
arrayOutputRow(colRemedy2) = arrayInputRow(colInputValue1) 'Else Assign to Remedy2
End If
Case "defct_dt" 'If Defect Date
arrayOutputRow(colDefectDt) = arrayInputRow(colInputValue1) 'Assign Val1 to Defect Date
Case "rdy_dt" 'If Remedy Date
arrayOutputRow(colRemedyDt) = arrayInputRow(colInputValue1) 'Assign Val1 to Remendy Date
End Select
Select Case arrayInputRow(colInputVar2) 'Check Var2
Case "Manufacturer" 'If Manufacturer
arrayOutputRow(colManufacturer) = arrayInputRow(colInputValue2) 'Assign Val2 to Manufacturer
Case "Supplier" 'If Supplier
arrayOutputRow(colSupplier) = arrayInputRow(colInputValue2) 'Assign Val2 to Supplier
End Select
End If
'Next Input Row
intInputRow = intInputRow + 1
Wend
End Sub
<强>输出
使用给定的输入，上面的代码将以下数据写入（预先存在的）工作表“输出”。 （同样，这是粘贴到Excel的标签。）
ID Dt problem1 Problem2 defect1 defect2 remedy1 remedy2 defect_dt remedy_dt Manufacturer Supplier
234456 3/14/2017 tap leakage LEAKAGE repaired 3/14/2017 3/17/2017 abc org xyz org
234457 3/21/2017 tap leakage motor problem LEAKAGE DEFECTIVE repaired repaired 3/21/2017 3/17/2017 edc org 123 org