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

標題: [發問] Excel 合併對應資料 [打印本頁]

作者: stephenlee 時間: 2022-8-6 11:17 標題: Excel 合併對應資料

自動合併資料所需

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或公式做到。謝謝

[attach]35116[/attach]

作者: samwang 時間: 2022-8-7 07:53

回復 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 時間: 2022-8-7 10:38

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

作者: stephenlee 時間: 2022-8-8 16:43

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

[attach]35130[/attach]

作者: samwang 時間: 2022-8-9 09:34

你好,大大

謝謝閣下花了這麼多時間幫我製作了這個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 時間: 2022-8-10 13:52

請再測試看看，謝謝
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

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

[attach]35141[/attach]

作者: samwang 時間: 2022-8-10 20:14

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

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

作者: samwang 時間: 2022-8-11 07:49

你好,大大,謝謝你再次幫忙,好像差一點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 時間: 2022-8-11 13:23

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

沒錯了,是這樣。

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

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

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