範囲、行、および列をループする

Question

大きなデータダンプがあり、以下の情報のスニペットで並べ替える必要があります。

を：私は何を探していますが

Part # A B C Op 
    2403253 1 7 4 Foundry 
    2403253 2 8 5 Foundry 
    2403253 3 9 6 Foundry 
    2403253 4 1 7 Foundry 
    2403253 5 2 8 Outside 
    2403253 6 3 9 Machining 
    2403253 7 4 1 Machining 
    2403253 8 5 2 Polishing 
    2403253 9 6 3 Polishing 
    2403254 1 7 4 Foundry 
    2403254 2 8 5 Foundry 
    2403254 3 9 6 Machining 
    2403254 4 1 7 Polishing 
    2403256 5 2 8 Foundry 
    2403256 6 3 9 Foundry 
    2403256 7 4 1 Machining 
    2403256 8 5 2 Polishing 
    2403257 9 6 3 Foundry 
    2403257 1 7 4 Foundry 
    2403257 2 8 5 Machining 
    2403257 3 9 6 Polishing 
    2403258 4 1 7 Foundry 
    2403258 5 2 8 Foundry 
    2403258 6 3 9 Polishing 

「パート#S」のそれぞれをループであり、A、Bを追加し、「オプス」のそれぞれとペアリング、& Cは一緒のような最終的な結果を得るために

Part # A B C Op 
    2403253 X X X Foundry 
      X X X Machining 
      X X X Outside 
      X X X Polishing 
    2403254 X X X Foundry 
      X X X Machining 
      X X X Outside 
      X X X Polishing 
    2403256 X X X Foundry 
      X X X Machining 
      X X X Outside 
      X X X Polishing 
    2403257 X X X Foundry 
      X X X Machining 
      X X X Outside 
      X X X Polishing 
    2403258 X X X Foundry 
      X X X Machining 
      X X X Outside 
      X X X Polishing 

私はそれについてどうなるかわかりません。どんな助けもありがとうございます。私はループ、統合、および他のものを理解しようとしました。私の朝食を食べながら、私は退屈していた

Answer 1

は、ので、ここでいくつかの（未テスト）コードです：あなたのための

Option Explicit 

Private rowDst As Long 
Private Results() As Integer 
Private currentPartNo As String 
Private Ops(4) As String 
Private wsDst As Worksheet 
Private op As Integer 
Private abc As Integer 

Sub RunMe() 
    'Switch off ScreenUpdating to speed up execution time 
    Application.ScreenUpdating = False 

    Dim wsSrc As Worksheet 
    Dim rowSrc As Long 
    Ops(1) = "Foundry" 
    Ops(2) = "Machining" 
    Ops(3) = "Outside" 
    Ops(4) = "Polishing" 

    Set wsSrc = Worksheets("Sheet1") 
    Set wsDst = Worksheets("Sheet2") 

    currentPartNo = "" 

    rowSrc = 2 
    rowDst = 2 
    Do While wsSrc.Cells(rowSrc, 1).Value <> "" 
     If wsSrc.Cells(rowSrc, 1).Value <> currentPartNo Then 
      'Different part #, so need to write out results for previous part # 
      WriteResults 
      'Keep track of current part # so we know when to write out results 
      currentPartNo = wsSrc.Cells(rowSrc, 1).Value 
      'Clear out current values from Results array 
      ReDim Results(3, 4) As Integer 
     End If 
     'Determine Op position 
     For op = 1 To 4 
      If wsSrc.Cells(rowSrc, 5).Value = Ops(op) Then 
       Exit For 
      End If 
     Next 
     'Loop through A, B and C, adding values into Results array 
     For abc = 1 To 3 
      Results(abc, op) = Results(abc, op) + wsSrc.Cells(rowSrc, abc + 1).Value 
     Next 
     'Increment row pointer 
     rowSrc = rowSrc + 1 
    Loop 
    'Write results for final part # 
    WriteResults 

    'Switch ScreenUpdating back on 
    Application.ScreenUpdating = True 

End Sub 

Private Sub WriteResults() 
    If currentPartNo <> "" Then 
     wsDst.Cells(rowDst + 0, 1).Value = currentPartNo 
     For op = 1 To 4 
      wsDst.Cells(rowDst + op - 1, 5).Value = Ops(op) 
      For abc = 1 To 3 
       wsDst.Cells(rowDst + op - 1, abc + 1).Value = Results(abc, op) 
      Next 
     Next 
     rowDst = rowDst + 4 
     currentPartNo = "" 
    End If 
End Sub 

（私は実際に提供してはならないコード - StackOverflowのはここにあるあなたが問題を解決することができ私が言ったように、私は退屈していた、あなたコードを持っていますが。）

Answer 2

結果がG、H、I、Jに入れられます以下のコードを1として

、K列を

Dim records As Integer, count As Integer, x As String 
records = 24 
count = 1 
Dim ops(4) As Variant 
ops(1) = "Foundry" 
ops(2) = "Machining" 
ops(3) = "Outside" 
ops(4) = "Polishing" 

For i = 2 To records + 1 
    If x <> Cells(i, 1).Value Then 
     x = Cells(i, 1).Value 
     For op = 1 To 4 
      For j = 2 To records + 1 
       If Cells(j, 1).Value = x And Cells(j, 5).Value = ops(op) Then 
        a = a + Cells(j, 2).Value 
        b = b + Cells(j, 3).Value 
        c = c + Cells(j, 4).Value 
       End If 
      Next j 

      If op = 1 Then 
       Cells(count, 7).Value = x 
      End If 
      Cells(count, 8).Value = a 
      Cells(count, 9).Value = b 
      Cells(count, 10).Value = c 
      Cells(count, 11).Value = ops(op) 

      count = count + 1 
      a = 0 
      b = 0 
      c = 0 
     Next op 

    End If 
Next i 

Answer 3

上記の正確なフォーマットが必要ない場合は、Pivo​​tテーブルを使用して、わずかに異なるレイアウトで同様の情報を表示できます。

データを使用して、行領域にPart #とOpをドラッグします。合計

の値エリアにドラッグしA、BとC結果：

または、アウトライン形式を選択した場合：