- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
6#
發表於 2023-6-15 16:37
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖延伸學習,學習方案如下,請各位前輩指教
資料表內容修改後:
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, Crr, V, Z, Q, P, i&, T$, T2$, T4$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheets("格式").UsedRange, [格式!A:A])
ReDim Crr(1 To UBound(Brr), 1 To 3)
For i = 1 To UBound(Brr)
If Brr(i, 1) <> "" Then Z(Brr(i, 1)) = i
Next
Brr = Range([工作表1!H2], [工作表1!E65536].End(3))
For i = 1 To UBound(Brr)
T = Brr(i, 1): T2 = Brr(i, 2): T4 = Brr(i, 4)
If T = "" Then GoTo i01
If InStr(T, "飲品") = 1 Then T2 = T: T = "飲品"
V = Z(T): If V = "" Then GoTo i01
Q = Z(T & "|" & T2): P = Z(T & "|")
If Val(Q) = 0 Then
Crr(V + P, 1) = T2
Crr(V + P, 2) = Brr(i, 3)
Z(T & "|" & T2) = V + P
Z(T & "|") = P + 1
GoTo i01
End If
Crr(Q, 2) = Crr(Q, 2) + Brr(i, 3)
i01: If T4 <> "" Then T = T4 & "|/" & T & "|" & T2: Z(T) = Z(T) + 1
Next
For Each V In Z.KEYS
If InStr(V, "|/") = 0 Then GoTo v01
P = Split(V, "|/")(0)
Q = Split(V, "|/")(1)
If Crr(Z(Q), 3) = "" Then
Crr(Z(Q), 3) = P & "X" & Z(V)
Else
Crr(Z(Q), 3) = Crr(Z(Q), 3) & "; " & P & "X" & Z(V)
End If
v01: Next
[格式!B1].Resize(UBound(Crr), 3) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub |
|
