循环范围,行和列

时间:2016-08-03 20:23:54

标签: excel excel-vba vba

我有一个大型数据转储需要通过下面的信息片段进行排序。

    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

我要做的是循环遍历每个" Part#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

我不知道该怎么做。任何帮助表示赞赏。我试过理解循环,整合和其他一些。

3 个答案:

答案 0 :(得分:0)

吃早餐时我很无聊,所以这里有一些(未经测试的)代码:

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可以帮助您解决您的代码所带来的问题,但正如我所说,我感到无聊。)< / p>

答案 1 :(得分:0)

根据以下代码,结果将被放入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

答案 2 :(得分:0)

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

使用您的数据,将$n = 5; for ($i = 0; $i < $n; $i++) { for ($j = 0; $j <= $n; $j++) { if ($j <= $i) { echo '*'; } else { echo $j; } } echo '<br>'; } for ($i = $n; $i > 0; $i--) { for ($j = 0; $j <= $n; $j++) { if ($j <= $i) { echo '*'; } else { echo $j; } } echo '<br>'; } Part #拖到行区域;将OpAB拖到Sum

的值区域

enter image description here

结果:

enter image description here

或者,如果您选择大纲表单:

enter image description here

相关问题