|
直接生成表1的结果?- Sub Macro2()
- Dim arr, brr, crr, ar, d, i&, j%, s&, s2&, n&
- Set d = CreateObject("scripting.dictionary")
- MyPath = ThisWorkbook.Path & ""
- Application.ScreenUpdating = False
- Workbooks.OpenText MyPath & "数据文件1.txt"
- With ActiveWorkbook
- arr = .Sheets(1).Range("A3").CurrentRegion
- .Close 0
- End With
- Workbooks.OpenText MyPath & "数据文件2.txt"
- With ActiveWorkbook
- brr = .Sheets(1).Range("A3").CurrentRegion
- .Close 0
- End With
- ReDim ar(1 To UBound(arr), 1 To UBound(arr, 2))
- ReDim crr(1 To UBound(brr), 1 To 2)
- For i = 2 To UBound(brr)
- If Not d.exists(brr(i, 10)) Then
- s = s + 1
- d(brr(i, 10)) = s
- crr(s, 1) = brr(i, 8)
- crr(s, 2) = brr(i, 7)
- Else
- n = d(brr(i, 10))
- crr(n, 1) = crr(n, 1) + brr(i, 8)
- crr(n, 2) = crr(n, 2) + brr(i, 7)
- End If
- Next
- For i = 1 To UBound(arr)
- If arr(i, 9) <> 0 Then
- s2 = s2 + 1
- For j = 1 To UBound(arr, 2)
- ar(s2, j) = arr(i, j)
- Next
- If d.exists(ar(s2, 14)) Then
- n = d(ar(s2, 14))
- ar(s2, 8) = crr(n, 1) / crr(n, 2)
- End If
- End If
- Next
- ActiveSheet.UsedRange.ClearContents
- Range("a1").Resize(s2, UBound(ar, 2)) = ar
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|