[發問] Excel 合併對應資料

stephenlee

自動合併資料所需

Sheet1 A欄及B欄是資料來源

而Sheet2 A欄當我需要打上job 時,B欄的Po要自動尋找被合併的內容來組合Po

B欄要用公式或者VBA 做,但一般 B2欄這些是可以用vlookup直接取得Sheet1 B欄的資料,但是如果像
Sheet2 A欄被組合了(05-06) 這樣則無法用vlookup 將他合併,如何取括號內的資料來對應取Sheet1內的Po欄資料到Sheet2 內的Po欄內,用 "/" 來分辨不同的Po。 結果像SHeet2 的一樣,如何用VBA或公式做到。謝謝

合併.rar (6.92 KB)

下載次數: 13

2022-8-6 11:17

samwang

回復 1# stephenlee

請測試看看，謝謝
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheets(1).Range("a1").CurrentRegion
For i = 2 To UBound(Arr): T = Arr(i, 1): xD(T) = Arr(i, 2): Next
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): If T = "" Then GoTo 99
        If xD.Exists(T) Then
            Arr(i, 2) = xD(T)
        Else
            a1 = Split(Split(T, "(")(1), "-")(0)
            a2 = Split(Split(Split(T, "(")(1), "-")(1), ")")(0)
            For Each ky In xD.keys
                br = Split(ky, "-"): If UBound(br) < 2 Then GoTo 98
                If br(2) >= a1 And br(2) <= a2 Then
                    If Arr(i, 2) = "" Then
                        Arr(i, 2) = xD(ky)
                    Else
                        Arr(i, 2) = Arr(i, 2) & "/" & xD(ky)
                    End If
                End If
98:          Next
        End If
99:     Next
    .[a1].Resize(UBound(Arr), 2) = Arr
End With
End Sub

hcm19522

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

stephenlee

回復  stephenlee

請測試看看，謝謝
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = C ...
samwang 發表於 2022-8-7 07:53

    你好,大大

謝謝閣下花了這麼多時間幫我製作了這個VBA, 這個VBA 完全符合我的要求,非常感謝,大大很強。
在此不好意思看閣下是否能幫我再看一下,新的要求,這次的要求是要根據 job 和line 來取SHeet2 的Po。



合併 v2.rar (7.61 KB)

下載次數: 4

2022-8-8 16:43

samwang

你好,大大

謝謝閣下花了這麼多時間幫我製作了這個VBA, 這個VBA 完全符合我的要求,非常感謝,大 ...
stephenlee 發表於 2022-8-8 16:43

請再測試看看，謝謝
Sub test()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2): xD(T) = Arr(i, 3)
        T = Arr(i, 1) & "|" & Split(Arr(i, 2), "-")(0): xD(T) = Arr(i, 3)
    Next
End With
With Sheets(1)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2)
        If xD.exists(T) Then
            Arr(i, 3) = xD(T)
        Else
            T = Arr(i, 1) & "|" & Split(Arr(i, 2), "-")(0): Arr(i, 3) = xD(T)
        End If
    Next
    .Range("a1").Resize(UBound(Arr), 3) = Arr
End With
End Sub

stephenlee

請再測試看看，謝謝
Sub test()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary ...
samwang 發表於 2022-8-9 09:34

你好,大大,謝謝你再次幫忙,好像差一點Sheet1 是資料來源,
當我在Sheet2 打上Job 和Line 後,Sheet2的Po欄會自動根據Job 和Line來取Sheet1 的Po資料, 每次資料都會變動,所以要根據Line內的范圍來取SHeet1的Po,

例如 SHeet1 的job 是
WEC-20-01     1-5        5241-MC

WEC-20-01      6-7      5242-KOL


例如我在SHeet2 打上
WEC-20-01    1-2  
WEC-20-01    3-5
WEC-20-01    6
WEC-20-01     7

由於Line在范圍內所以結果為


WEC-20-01    1-2     5241-MC
WEC-20-01    3-5      5241-MC
WEC-20-01    6           5242-KOL
WEC-20-01     7          5242-KOL

又再麻煩你看看能不能再弄一下,感激。



合併 v2.rar (7.61 KB)

下載次數: 4

2022-8-10 13:52

samwang

你好,大大,謝謝你再次幫忙,好像差一點Sheet1 是資料來源,
當我在Sheet2 打上Job 和Line 後,Sheet2的 ...
stephenlee 發表於 2022-8-10 13:52

4樓和6樓需求不太一樣，請再確認實際需求，謝謝

samwang

你好,大大,謝謝你再次幫忙,好像差一點Sheet1 是資料來源,
當我在Sheet2 打上Job 和Line 後,Sheet2的 ...
stephenlee 發表於 2022-8-10 13:52

是這樣嗎? 請測試看看，謝謝
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheets(1).Range("a1").CurrentRegion
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 2): xD(T) = Arr(i, 3)
Next
With Sheets(2)
    Arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2)
        If xD.Exists(T) Then
            Arr(i, 3) = xD(T)
        Else
            a1 = Split(Arr(i, 2), "-")(0): a2 = Split(Arr(i, 2), "-")(1)
            For Each ky In xD.keys
                If Split(ky, "|")(0) <> Arr(i, 1) Then GoTo 98
                br = Split(Split(ky, "|")(1), "-")
                If UBound(br) < 1 Then GoTo 98
                If br(0) <= a1 And br(1) >= a2 Then Arr(i, 3) = xD(ky)
98:         Next
        End If
    Next
    .[a1].Resize(UBound(Arr), 3) = Arr
End With
End Sub

stephenlee

是這樣嗎? 請測試看看，謝謝
Sub test()
Dim Arr, xD, T$, br, a1$, a2$, ky, i&
Set xD = CreateOb ...
samwang 發表於 2022-8-11 07:49

  沒錯了,是這樣。

不好意思前面可能說得不太清楚。現在已滿足了我的工作需求了。

非常感謝大大的幫忙花了這麼長的時間幫我研究,非常感謝。
你真的很勵害。在此跪謝了。