標題: [發問] 請問如何依類別分類並依序貼上不重複值 [打印本頁]

---

作者: starry1314    時間: 2015-5-23 01:17     標題: 請問如何依類別分類並依序貼上不重複值

[attach]21019[/attach]

處理前                                               處理後
[attach]21020[/attach][attach]21021[/attach]

---

作者: starry1314    時間: 2015-5-23 02:10

回復 1# starry1314


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

---

作者: hcm19522    時間: 2015-11-1 17:22

=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    時間: 2015-11-1 17:43

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

---

作者: Andy2483    時間: 2023-6-14 16:27

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

資料表:
[attach]36585[/attach]

結果表執行前:
[attach]36586[/attach]

執行結果:
[attach]36587[/attach]


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    時間: 2023-6-15 16:37

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

資料表內容修改後:
[attach]36593[/attach]

執行結果:
[attach]36594[/attach]


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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)