- 帖子
- 554
- 主題
- 72
- 精華
- 0
- 積分
- 651
- 點名
- 1
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2025-11-11
|
回復 198188
將18樓方案 Crr(N, 3) = Crr(N, 3) & ")": Crr(N, 5) = "=" & Crr(N, 3)
改成 ...
Andy2483 發表於 2025-11-11 09:13  - Option Explicit
- Sub TEST11()
- Const Ref = 2
- Dim Brr, Crr, Y, Z(0 To Ref + 1), K, i&, j%, N&, T1$, T8$, d%
- Set Y = CreateObject("Scripting.Dictionary")
- For i = 0 To Ref + 1: Set Z(i) = CreateObject("Scripting.Dictionary"): Next
- Brr = Sheets(1).[A1].CurrentRegion
- For i = 2 To UBound(Brr)
- If Z(1)(Brr(i, 1)) = "" Then
- Z(1)(Brr(i, 1)) = "(" & Val(Brr(i, 3))
- Else
- Z(1)(Brr(i, 1)) = Z(1)(Brr(i, 1)) & "+" & Val(Brr(i, 3))
- End If
- Next
- Brr = Sheets(2).[A1].CurrentRegion
- For d = 2 To Ref + 1
- For i = 2 To UBound(Brr)
- T1 = Brr(i, 1)
- T8 = Brr(i, 8)
- If Y.Exists(i) Then GoTo i01
- If Z(d - 1).Exists(T8) And Z(d - 1)(T8 & "/") = "" And Not Z(d - 2).Exists(T8) Then
- Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
- Z(d)(T1) = Brr(i, 3)
- Z(d - 1)(T8 & "/") = Brr(i, 3)
- Y(i) = ""
- Z(d)(T8) = Brr(i, 3)
- ElseIf Z(d - 1)(T8 & "/") <> "" Then
- Z(d)(T1) = Z(d)(T8) & "+" & Val(Brr(i, 3))
- Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
- Y(i) = ""
- Z(d)(T8) = Brr(i, 3)
- End If
- i01: Next
- Next
- ReDim Crr(1 To Y.Count, 1 To UBound(Brr, 2))
- For Each K In Y.Keys
- N = N + 1
- For j = 1 To UBound(Brr, 2): Crr(N, j) = Brr(K, j): Next
- Crr(N, 3) = Crr(N, 3) = Evaluate(Crr(N, 3) & ")")
- Next
- If N > 0 Then Workbooks.Add: [A1].Resize(N, UBound(Brr, 2)) = Crr
- End Sub
|
|
發表於 
