麻辣家族討論版版 - Powered by Discuz! Board

標題: 同一發票號碼列出所有訂單編號(列在同一儲存格) [打印本頁]

作者: leiru 時間: 2021-10-12 14:37 標題: 同一發票號碼列出所有訂單編號(列在同一儲存格)

列出同一發票號碼的所有訂單編號(顯示在同一儲存格)
答案呈現結果如D欄及E欄

作者: ML089 時間: 2021-10-12 16:27

E2公式
Exel 2003
=INDEX($B:$B,SMALL(($D2<>$A$2:$A$7)*999+ROW($2:$7),COLUMN(A1)))&IF(F9="","","、"&F9)
右拉至空格出現，在整個下拉

Excel 365
=TEXTJOIN("、",,IF(D2=A$2:A$7,B$2:B$7,""))
下拉

作者: hcm19522 時間: 2021-10-12 16:49

https://blog.xuite.net/hcm19522/twblog/590069939

作者: samwang 時間: 2021-10-13 18:01

回復 1# leiru
請測試看看，謝謝
Sub test()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
If xD.Exists(T) Then
xD(T) = xD(T) & "、" & Arr(i, 2)
Else
xD(T) = Arr(i, 2)
End If
99: Next i
Range("d2").Resize(xD.Count, 1) = Application.Transpose(xD.keys)
Range("e2").Resize(xD.Count, 1) = Application.Transpose(xD.Items)
End Sub

作者: Andy2483 時間: 2021-10-14 12:00

回復 4# samwang

請教前輩字典只能1個key對應item? 可以1個對多個嗎?

作者: samwang 時間: 2021-10-14 12:27

回復 samwang

請教前輩字典只能1個key對應item? 可以1個對多個嗎?
Andy2483 發表於 2021-10-14 12:00

key可以很多個，但是每個key 是唯一，且對應的item可以很多個，謝謝。

作者: Andy2483 時間: 2021-10-14 12:35

回復 6# samwang

謝謝指導
再請教
如果發票號碼對應的客戶訂單不要用、符號個開放同一儲存格,
而是分開放在右側的儲存格接下去放!要怎麼改?

作者: samwang 時間: 2021-10-14 14:07

回復 samwang

謝謝指導
再請教
如果發票號碼對應的客戶訂單不要用、符號個開放同一儲存格,
...
Andy2483 發表於 2021-10-14 12:35

Sub test2()
Dim Arr, Brr(), xD, T$, k, TC%, TC1%, R%, C%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
If xD.Exists(T) Then
      xD(T) = xD(T) & "、" & Arr(i, 2)
Else
      xD(T) = Arr(i, 2)
End If
99: Next i
ReDim Brr(1 To xD.Count, 1 To UBound(Arr))
R = 1
For Each k In xD.keys
xD(k) = Split(xD(k), "、")
TC = UBound(xD(k)) + 2
If TC > TC1 Then TC1 = TC
Brr(R, 1) = k
For C = 2 To UBound(xD(k)) + 2
      Brr(R, C) = xD(k)(C - 2)
Next
R = R + 1
Next
Range("g2").Resize(R - 1, TC1) = Brr
End Sub

作者: Andy2483 時間: 2021-10-14 16:47

回復 8# samwang

謝謝指導!
如果列數多!您的執行的時間比我會的方式快很多!
謝謝前輩指導! xD(k)(C - 2)

Sub test2_1()
Dim Arr, Brr(), xD, T$, k, MA%, R%, C%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
xD(T) = xD(T) + 1
99: Next i
MA = WorksheetFunction.Max(xD.Items)
ReDim Brr(0 To xD.Count, 1 To MA + 1)
i = 0
For Each k In xD.keys
Brr(i, 1) = k
R = 2
For C = 2 To UBound(Arr)
   If Arr(C, 1) = Brr(i, 1) Then
      Brr(i, R) = Arr(C, 2)
      R = R + 1
   End If
Next
i = i + 1
Next
Range("g2").Resize(xD.Count, MA + 1) = Brr
End Sub

作者: 准提部林 時間: 2021-10-17 10:53

兩欄式:
Sub test_01()
Dim Arr, xD, i&, T$, T2$, R&, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): T2 = Arr(i, 2): R = xD(T)
If T = "" Or T2 = "" Then GoTo 99
If R > 0 Then Arr(R, 2) = Arr(R, 2) & "、" & T2: GoTo 99
N = N + 1: R = N + 1: xD(T) = R
Arr(R, 1) = Arr(i, 1): Arr(R, 2) = T2
99: Next i
Range("d1").Resize(N + 1, 2) = Arr
End Sub

作者: 准提部林 時間: 2021-10-17 10:54

多欄式:
Sub test_02()
Dim Arr, Brr, xD, i&, T$, T2$, R&, C%, Cx%, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 200)
For i = 2 To UBound(Arr)
T = Arr(i, 1): T2 = Arr(i, 2)
If T = "" Or T2 = "" Then GoTo 99
R = xD(T): C = xD(T & "/c")
If R = 0 Then N = N + 1: R = N + 1: xD(T) = R: Brr(R, 1) = Arr(i, 1)
C = C + 1: xD(T & "/c") = C: Brr(R, C + 1) = T2
If C > Cx Then Cx = C: Brr(1, Cx + 1) = "訂單(" & Cx & ")"
99: Next i
Brr(1, 1) = "發票號碼"
Range("g1").Resize(N + 1, Cx + 1) = Brr
End Sub

作者: Andy2483 時間: 2023-1-5 16:47

回復 11# 准提部林

謝謝前輩
一年多了,現在才大概看懂
執行結果:
[attach]35728[/attach]

Option Explicit
Sub test_02()
Dim i&, N&, R&, T$, T2$, C%, Cx%, Arr, Brr, xD
'↑宣告變數(i,N,R)是長整數變數,(T,T2)是字串變數,(C,Cx)是短整數變數,
'其它是通用型變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Arr = Range([a1], [b65536].End(3))
'↑令Arr是二維陣列!以[A1]到B欄最後一個有內容儲存格,這範圍儲存格值帶入
ReDim Brr(1 To UBound(Arr), 1 To 200)
'↑宣告Brr陣列範圍!縱向從1到Arr陣列最大索引列號,橫向從1到200
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到 Arr陣列最大索引列號
T = Arr(i, 1)
'↑令T這字串變數是 i迴圈列1欄Arr陣列值
T2 = Arr(i, 2)
'↑令T2這字串變數是 i迴圈列2欄Arr陣列值
If T = "" Or T2 = "" Then GoTo 99
'↑如果T字串變數是空字元或  如果T2字串變數是空字元,就跳到99位置繼續執行
R = xD(T)
'↑令R這長整數變數是以T字串變數查xD字典回傳的item值  (PS:若查不到!R初始值是 0)
C = xD(T & "/c")
'↑令C這短整數變數是以T字串變數連接"/c"的新字串,查xD字典回傳的item值
'(PS:若查不到!C初始值是 0)
If R = 0 Then
'↑如果R變數是 0 ??
   N = N + 1
   '↑令N這長整數變數是自身值 +1  (PS:N初始值是 0)
   R = N + 1
   '↑令R變數是 N變數 +1
   xD(T) = R
   '↑令以T變數當key,item是 R變數,放回字典
   Brr(R, 1) = Arr(i, 1)
   '↑令變數列1欄Brr陣列值是 i迴圈列1欄Arr陣列值
End If
C = C + 1
'↑令C變數是自身值 +1
xD(T & "/c") = C
'↑令以T變數連接"/c"的新字串當key,item是 C變數,放入字典
Brr(R, C + 1) = T2
'↑令R變數列(C1變數+1)欄Brr陣列值是 T2字串變數
If C > Cx Then Cx = C: Brr(1, Cx + 1) = "訂單(" & Cx & ")"
'↑如果C變數 > Cx這短整數變數,就令Cx變數是 C變數,
'1列(Cx變數+1)欄Brr陣列值是 "訂單(" 連接 Cx變數再連接 ")" 組成的新字串
99: Next i
Brr(1, 1) = "發票號碼"
Range("g1").Resize(N + 1, Cx + 1) = Brr
'[G1]儲存格擴展向下(N變數+1)列,向右擴展(Cx變數+1)欄,這範圍儲存格值以Brr陣列值帶入
End Sub

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