VBAを使用してデータを再構成する

Question

私はVBスクリプティングには新しく、以下の形式でデータを再構築するのに役立ちます。

データIは、IDごとに1つの行を必要

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  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  

所望の出力以下の形式です。助けてください。

ありがとうございました

Answer 1

あなたの質問は重大に投票されました。私はあなたのための試行された解決策を持っていますが、私はかなりの仮定をしなければなりませんでした。これらは、より良い言葉の質問が避けていた仮定です。仮定が間違っていれば、私が提供している解決策は簡単には機能しません。これらは私の仮定されている：あなたの入力データは、Excelワークシート内に存在する

仮定

1. （私は「入力」と呼んできた）
2. あなたは別のExcelワークシートでの出力データが欲しい（I
3. 入力データは常に同じソートされているので、同じIDを持つレコードは隣接する行にあります。
4. 2つ以上の問題/不具合/救済の必要はなく、複数の製造元またはサプライヤの必要はありません
5. 私はあなたの投稿のデータを理解したと思います。最初のデータセットは「固定幅」（Excelデータでは奇妙に見える）として表示されます。 2番目はあまり明確ではありませんが、最初のデータセットとの共通点に基づいて、私はそれを解決することができたと思います。
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