- 帖子
- 2843
- 主題
- 10
- 精華
- 0
- 積分
- 2899
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-7-17
|
- Sub TEST()
- Dim R&, N&, Arr, Brr, xD, T$, i&
- Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
- Arr = Sheets("Sheet1").UsedRange
- ReDim Brr(1 To UBound(Arr), 1 To 8)
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 3 To UBound(Arr)
- If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
- T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
- R = xD(T)
- If R = 0 Then
- N = N + 1: R = N: xD(T) = N
- Brr(R, 1) = Arr(i, 7)
- Brr(R, 2) = Arr(i, 8)
- Brr(R, 3) = Arr(i, 10)
- Brr(R, 7) = Arr(i, 4)
- Brr(R, 8) = Split(T, "|")(0)
- End If
- If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
- If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
- If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
- 101: Next i
- If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
- End Sub
|
|
發表於 2016-3-16 11:02
| 