Looping Through Ranges, Rows и Columns

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» и его сопряжение с каждым из «Ops», добавив, 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, 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

Если вам не нужен точный формат, который вы видите выше, сводная таблица может предоставить вам аналогичную информацию в несколько иной компоновке.

Использование Ваших данных, перетащите Part # и Op в область Строки; Drag A, B и C в область Значения для Sum

Результат:

Или, если вы выбираете форму Outline: