[發問] 請問如何依類別分類並依序貼上不重複值

starry1314

依類別分類並依序貼上不重複值.zip (29.58 KB)

下載次數: 7

2015-5-23 01:14

處理前                                               處理後

下載 (11.45 KB)

2015-5-23 01:17

下載 (14.91 KB)

2015-5-23 01:17

starry1314

回復 1# starry1314


    處理後的表格的A欄是固定名稱,要讓B欄依A欄的類別名稱自動抓取工作表1的品名,且不重複值

hcm19522

=IFERROR(INDEX(工作表1!F:F,SMALL(IF((工作表1!E$2:E$51=LOOKUP(1,0/(A$1:A1<>""),A$1:A1))*(MATCH(工作表1!F$2:F$51,工作表1!F$2:F$51,)=ROW(E$2:E$51)-1),ROW(E$2:E$51)),ROW(A1)+1-LOOKUP(1,0/(A$1:A1<>""),ROW(A$1:A1)))),"")

hcm19522

http://blog.xuite.net/hcm19522/twblog/353777556

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA陣列與字典,學習方案如下,請各位前輩指教

資料表:

下載 (255.43 KB)

2023-6-14 16:26

結果表執行前:

下載 (102.86 KB)

2023-6-14 16:27

執行結果:

下載 (80.88 KB)

2023-6-14 16:27

Option Explicit
Sub TEST() '↑
Dim Brr, Crr, V, Z, Q, P, i&, T$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheets("格式").UsedRange, [格式!A:A])
ReDim Crr(1 To UBound(Brr), 1 To 2)
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): If T = "" Then GoTo i01
   If InStr(T, "飲品") = 1 Then Brr(i, 2) = T: T = "飲品"
   V = Z(T): If V = "" Then GoTo i01
   Q = Z(T & "|" & Brr(i, 2)): P = Z(T & "|")
   If Val(Q) = 0 Then
      Crr(V + P, 1) = Brr(i, 2)
      Crr(V + P, 2) = Brr(i, 3)
      Z(T & "|" & Brr(i, 2)) = V + P
      Z(T & "|") = P + 1
      GoTo i01
   End If
   Crr(Q, 2) = Crr(Q, 2) + Brr(i, 3)
i01: Next
[格式!B1].Resize(UBound(Crr), 2) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖延伸學習,學習方案如下,請各位前輩指教

資料表內容修改後:

下載 (285.54 KB)

2023-6-15 16:36

執行結果:

下載 (103.24 KB)

2023-6-15 16:36

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