|
本帖最后由 eennoo 于 2022-6-27 14:56 编辑
Sub main()
Dim result() As String, objSheet As Worksheet
Dim RowCount As Long
ReDim result(1 To Cells.Rows.Count, 1 To Range("A:L").Columns.Count) As String
For Each objSheet In Worksheets
If objSheet.Name Like "*数据源*" Then
Set usdRng = Range(objSheet.Range("A3"), objSheet.Range("A3").End(xlDown).Offset(0, 11))
RowCount = RowCount + usdRng.Rows.Count
For i = 1 To usdRng.Rows.Count
Set Rng = usdRng(i, 1).Resize(1, usdRng.Columns.Count)
k = 1
L = Rng.Columns.Count
total Rng, result, k, L
Next
End If
Next
Sheet1.Range("A3:L65536").Clear
Sheet1.Range("A3").Resize(RowCount, 12) = result
'设置颜色
Sheet1.Range("F3:L" & RowCount).SpecialCells(xlCellTypeConstants, 23).Interior.Color = RGB(0, 200, 0)
End Sub
Sub total(ByRef source, ByRef result, ByVal k, ByVal L)
If Len(result(k, 1)) = 0 Then
For c = 1 To L
result(k, c) = source(1, c)
Next
Exit Sub
Else
Dim flag As Boolean
flag = True
For c = 2 To 5
If result(k, c) = CStr(source(1, c)) Then flag = flag And True Else flag = flag And False
Next
If flag Then
For c = 1 To 5
result(k, c) = source(1, c)
Next
For c = 6 To L
If result(k, c) = "" Then result(k, c) = source(1, c)
Next
Exit Sub
End If
total source, result, k + 1, L
End If
End Sub
|
评分
-
查看全部评分
|