vba数据导出汇总问题求助 - 编程论坛

#2

阳光上的桥2023-04-03 09:59

经过下载附加，楼主的表1如下图：

只有本站会员才能查看附件，请登录

表2如下图：

只有本站会员才能查看附件，请登录

我写的程序代码如下图：

只有本站会员才能查看附件，请登录

程序执行后，能执行楼主的汇总，最后发现楼主要求最后汇总时把【点xxxx】汇总到【主xxxx】里面，程序代码修改了最后一个if判断，增加了right(,4),程序代码如下：

程序代码：

Option Explicit

Sub x()
    Dim arr, i, j, k, arr2(1 To 1000, 1 To 3), arr3(1 To 1000, 1 To 2), n2, n3, i3
    '从表1数据汇总arr2
    n2 = 0
    arr = Sheets("PO#230212").UsedRange '表1内容
    For i = 2 To UBound(arr)
        For Each k In Array(6, 8, 10, 12) 'F、H、J、L列
            j = k + 1
            If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j) '处理合并单元格
            If arr(i, k) <> "" Then
                'arr(i,1)、 arr(i,k)、arr(i,j) 一组数据累加到数组arr2中
                n2 = n2 + 1
                arr2(n2, 1) = arr(i, 1)
                arr2(n2, 2) = arr(i, k)
                arr2(n2, 3) = arr(i, j)
            End If
        Next k
    Next i
    '从arr2汇总arr3
    n3 = 0
    For i = 1 To n2
        For i3 = 1 To n3
            If Right(arr3(i3, 1), 4) = Right(arr2(i, 3), 4) Then Exit For
        Next i3
        If i3 > n3 Then
            arr3(i3, 1) = arr2(i, 3)
            n3 = i3
        End If
        arr3(i3, 2) = arr3(i3, 2) + arr2(i, 2)
    Next i
    '把结果arr2、arr3保存到 H 列（最后楼主自己修改为A列）
    Sheets("生成").Activate
    Range("h:j").ClearContents
    Cells(1, "H").Resize(n2, 3) = arr2
    Cells(n2 + 2, "H").Resize(n3, 2) = arr3
End Sub

#3

shiqiw2023-04-03 13:06

回复 2楼阳光上的桥

谢谢大佬，是我想要导出的数据，但是有几个问题:
1.能否按照主点关的顺序排列编号
2.像是有两个数据组成的主或点，能够给他合并单元格
3.有些我在编号后面备注其他信息的，编号数据没有导出
4.有些编号因为都是同样的数据，所以我将几个编号放在一个单元格，这种也不会导出
问题4，我将编号多个放在一起，不知是否会影响主点关想加的合计数

#4

shiqiw2023-04-03 15:40

回复 2楼阳光上的桥

大佬我觉得我的数据表是有些乱，操作起来比较繁琐，我新修改了一种
希望能够生成如下
1.根据原始数据表生成，编号后面的数据是原始数据表第二行红色的数据
2.把每一个编号对应的主色/点色/发际线数据导出有些主色/点色长度是多个，希望能够合并单元格
3.根据余发列的数据导出每一长度余发不是0的数据并汇总
具体数据已重新上传，麻烦大佬再帮忙看一下吧
https://wwi.
密码:9tgk

#5

quedeboy2023-04-08 19:26

真复杂！！！