楼主
liuguansky |
Q：如何对多表不同格式进行行列不重复值返回并交叉汇总？
A：用如下代码可以实现[数组+字典]：
- Sub justtest()
- Dim drow, dcol, dsum, sht As Worksheet, arrcol, arrrow, arrsum, i&, j&, str1$, arr1, arr2, arr3, str2$, arrre
- Set drow = CreateObject("scripting.dictionary")
- Set dcol = CreateObject("scripting.dictionary")
- Set dsum = CreateObject("scripting.dictionary")
- For Each sht In Worksheets
- If sht.Name <> "統計" Then
- With sht
- arrcol = .Range(.Cells(1, 2), .Cells(1, 2).End(2).Offset(1, 0))
- arrrow = .Range(.Cells(3, 1), .Cells(3, 1).End(4))
- arrsum = .Cells(3, 2).Resize(UBound(arrrow, 1), UBound(arrcol, 2))
- For i = 1 To UBound(arrcol, 2)
- dcol(arrcol(1, i) & vbTab & arrcol(2, i)) = ""
- Next i
- For i = 1 To UBound(arrrow, 1)
- drow(arrrow(i, 1)) = ""
- Next i
- For i = 1 To UBound(arrcol, 2)
- For j = 1 To UBound(arrrow, 1)
- str1 = arrcol(1, i) & vbTab & arrcol(2, i) & vbTab & arrrow(j, 1)
- If dsum.exists(str1) Then
- dsum(str1) = dsum(str1) + arrsum(j, i)
- Else: dsum.Add str1, arrsum(j, i)
- End If
- Next j, i
- End With
- End If
- Next
- With Sheets("統計")
- .Cells.ClearContents
- .[a1:a2] = [{""; "電視大小尺寸"}]
- arr1 = dcol.keys
- .[a3].Resize(drow.Count, 1) = Application.Transpose(drow.keys)
- ReDim arr2(0 To 1, 0 To UBound(arr1))
- For i = 0 To UBound(arr1)
- arr2(0, i) = Split(arr1(i), vbTab)(0)
- arr2(1, i) = Split(arr1(i), vbTab)(1)
- Next i
- .[b1].Resize(2, dcol.Count) = arr2
- arr3 = drow.keys
- ReDim arrre(0 To UBound(arr3), 0 To UBound(arr1))
- For i = 0 To UBound(arr1)
- For j = 0 To UBound(arr3)
- str2 = arr1(i) & vbTab & arr3(j)
- arrre(j, i) = IIf(dsum.exists(str2), dsum(str2), 0)
- Next j, i
- .[b3].Resize(drow.Count, dcol.Count) = arrre
- End With
- End Sub
 桌面.rar
|