[已解决]通过单元格内容进行汇总

ms967967

汇总单元格内容.zip (5.64 KB, 下载次数: 25)

2014-1-17 21:14 上传

点击文件名下载附件 如附件内说明，通过N个单元格的批注和内容进行汇总。生成明细表格。
请高手给写个VBA。谢谢帮助。

最佳答案

月排行榜 / 总排行榜

上清宫主

2014-1-18 14:24

Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row
If Cells(i, 1) = "" Then Exit Sub
ar = Range("a3:c" & i).Value
ReDim br(1 To i * 2, 1 To 4)
For i = 3 To 1 Step -2
    For i2% = 1 To UBound(ar)
        If stemp$ = ar(i2, i) Then
           br(r, 4) = br(r, 4) + 1
        Else
           r = r + 1
           br(r, 1) = Cells(i2 + 2, i).Comment.Text
           br(r, 2) = ar(i2, i)
           br(r, 3) = Left(br(r, 1), 2)
           br(r, 4) = 1
           If r > 1 Then br(r - 1, 1) = br(r - 1, 1) & "-" & Left(br(r - 1, 1), 2) & (1 * Right(br(r - 1, 1), 3) + br(r - 1, 4) - 1)
           stemp$ = ar(i2, i)
        End If
    Next
Next
If r > 1 Then
   br(r, 1) = br(r, 1) & "-" & Left(br(r, 1), 2) & (1 * Right(br(r, 1), 3) + br(r, 4) - 1)
   [a35].Resize(r, 4) = br
End If
End Sub
示例似乎有错

跳转到最佳答案楼层

ms967967

上清宫主 发表于 2014-1-18 14:24
Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row

上清宫主 发表于 2014-1-18 14:24
Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row

汇总单元格内容.zip (14.52 KB, 下载次数: 7)

2014-1-25 19:20 上传

点击文件名下载附件
老师你好，我重新修改了图例，有两个问题还要麻烦你帮助解决（有些简单的设置我摸索着可以调整了，附件中提到的两个问题没能做出来）。
还请老师百忙之中给予解决，谢谢支持。

上清宫主

Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row
If Cells(i, 1) = "" Then Exit Sub
ar = Range("a3:c" & i).Value
ReDim br(1 To i * 2, 1 To 4)
For i = 3 To 1 Step -2
    For i2% = 1 To UBound(ar)
        If stemp$ = ar(i2, i) Then
           br(r, 4) = br(r, 4) + 1
        Else
           r = r + 1
           br(r, 1) = Cells(i2 + 2, i).Comment.Text
           br(r, 2) = ar(i2, i)
           br(r, 3) = Left(br(r, 1), 2)
           br(r, 4) = 1
           If r > 1 Then br(r - 1, 1) = br(r - 1, 1) & "-" & Left(br(r - 1, 1), 2) & (1 * Right(br(r - 1, 1), 3) + br(r - 1, 4) - 1)
           stemp$ = ar(i2, i)
        End If
    Next
Next
If r > 1 Then
   br(r, 1) = br(r, 1) & "-" & Left(br(r, 1), 2) & (1 * Right(br(r, 1), 3) + br(r, 4) - 1)
   [a35].Resize(r, 4) = br
End If
End Sub
示例似乎有错

ms967967

上清宫主 发表于 2014-1-18 14:24
Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row

非常感谢您的帮助，由于示例的错误给你带来不便深表歉意。
您的答案已经达到我的要求，不过我在演示时发现，如果将两排机床同时生产一个产品编号时，就不出结果了，请帮助查找一下原因。

ms967967

上清宫主 发表于 2014-1-18 14:24
Sub test()
Dim ar(), br()
i% = Range("A3").End(xlDown).Row

如果我再增加一排机床，我要改哪处的设置

ms967967

期待解决中

hetianjun888

学习了 谢谢