- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
題意不清, 就無法回應!!!- Sub TEST()
- Dim T$, Arr, Brr, Crr, Bn&, Cn&, Sb, Sc, i&, j%
- [G3:I6000,K3:M6000].ClearContents: [I1,M1] = ""
- If [G1] = "" Then Exit Sub
- Arr = Range("B2:D" & Cells(Rows.Count, 2).End(xlUp).Row)
- ReDim Brr(1 To UBound(Arr), 1 To 3): Crr = Brr
- For i = 1 To UBound(Arr)
- If Arr(i, 1) <> [G1] Then GoTo 101
- If Left(Arr(i, 2), 1) Like "[0-1]" Then
- Bn = Bn + 1: Sb = Sb + Val(Arr(i, 3))
- For j = 1 To 3: Brr(Bn, j) = Arr(i, j): Next
- ElseIf Left(Arr(i, 2), 1) Like "[2-9]" Then
- Cn = Cn + 1: Sc = Sc + Val(Arr(i, 3))
- For j = 1 To 3: Crr(Cn, j) = Arr(i, j): Next
- End If
- 101: Next i
- If Bn > 0 Then [G3:I3].Resize(Bn) = Brr: [I1] = Sb
- If Cn > 0 Then [K3:M3].Resize(Cn) = Crr: [M1] = Sc
- End Sub
 Xl0000193.rar (20.08 KB)
|
|
發表於 2016-10-21 16:53
| 