同一發票號碼列出所有訂單編號(列在同一儲存格)

leiru

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

ML089

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

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

samwang

回復 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

回復 4# samwang


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

samwang

回復  samwang


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

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

Andy2483

回復 6# samwang


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

samwang

回復  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

回復 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

准提部林

兩欄式:
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