循环遍历范围，行和列

-1

我有一个大的数据转储，需要通过下面的信息片段进行排序。循环遍历范围，行和列

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

我所希望做的是循环遍历每个“部件＃秒”，并与每一个“行动”的配对将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

我不知道该如何去做。任何帮助表示赞赏。我尝试了解循环，合并和其他一些。

来源

2016-08-03 Nathan Williams

是否有固定数量的“操作”，一个如果所有这些Ops都显示在最终结果中，即使A，B和C的值为0，那么它是否会关系？（也就是说结果是否为每个零件编号生成了固定的行数，或者如果零件编号仅有源操作记录为3个操作步骤，您是否只需要显示3行？） – YowE3K

每个零件都需要4个操作单元中的每一个即使它是零。也可以更容易地使用4个相同的零件号，以后可以在Excel中使用Filter。 –

并且当前数据是否可以在零件编号顺序中排序或可以排序？如果是这样，这个过程就简单多了。 – YowE3K

我很无聊而吃我的早餐，所以这里是一些（未经测试）代码：

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是来帮助你解决问题，你有您代码，但正如我所说的，我很无聊。）

来源

2016-08-03 21:06:36 YowE3K

按下面的代码的结果将投入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

来源

2016-08-03 21:10:59

如果您不需要上面显示的精确格式，则数据透视表可以以略微不同的布局为您提供类似信息。

使用您的数据，将Part #和Op拖到行区域;拖动A，B和C把价值观面积之和