使用VBA重构数据

Question

我对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一行。能否请你帮忙。

谢谢

Answer 1

您的问题已经被大幅投票。我为你尝试了一些解决方案，但我必须做出很多假设。这些都是一个更好的措辞问题可以避免的假设，如果假设是错误的，那么我提供的解决方案根本无法为您工作。这是我的假设：

假设

1. 输入数据驻留在Excel工作表（我称之为“输入”）
2. 要在其他Excel工作表（您的输出数据I已将其称为“输出”）
3. 输入数据将始终进行预先排序，以便具有相同ID的记录位于相邻行上。
4. 对于每个ID，将不会有超过2个问题/缺陷/补救措施的要求，并且不需要多个制造商或供应商
5. 我想我理解了您的文章中的数据。第一个数据集显示为“固定宽度”（这对于Excel数据来说似乎很奇怪）。第二个不太清楚，但基于与第一个数据集的共同点，我认为我设法解决了这个问题。
6. 可能还有其他的假设我正在做，这些是我所知道的。

标签Delimeted数据（粘贴到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