vba数据导出汇总问题求助
现有一组比较杂乱的数据,我需要将表1数据导出成表2的形式,同时能根据表2计算我想要的下一个数据,求大佬帮助!https://wwi.
2023-04-03 08:59
程序代码:
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
2023-04-03 09:59
2023-04-03 13:06
2023-04-03 15:40
2023-04-08 19:26