返回列表 上一主題 發帖

跨欄對比

跨欄對比

未命名12.png
2024-3-2 12:21

有三個表格,在表格“1”執行,
表格“1” 欄B 和欄G 兩樣分別在表格“KP" & "KH" 找尋,如果找到相同的數據。

舉例:
96089 & 5580 組合在KP 表塈鋮
“1”表的欄M (Project) 傳回"KP"表的 "$A$1"
“1”表的欄O (KP) 傳回"KP"表的 "$C$1"

96183 & 4780 組合在 KP & KH 表堻ㄖ鋮
"1”表的欄M (Project) 傳回"KP"表的 "$H$1" & "KH" 表的“$H$1", 兩者都是"BH" 相同,所以顯示"BH"
"1”表的欄N (KH) 傳回"KH"表的 "$J$1"
"1”表的欄O (KP) 傳回"KP"表的 "$J$1"

94851 & 5370 組合在 KH 表堻ㄖ鋮
"1”表的欄M (Project) 傳回"KH"表的 "$A$1" &  "$H$1", 兩者不 相同,所以顯示"BF/BH"
"1”表的欄N (KH) 傳回"KH"表的 "$C$1" &  "$J$1", 兩者都是“噴油”相同,所以顯示“噴油”

96093 & 5260 組合在 KH & KP表堻ㄖ鋮
"1”表的欄M (Project) 傳回"KP"表的"$A$1" & "$H$1" & "KH" 表的"$A$1" & "$H$1", 四都是"BF/ BH/ BF/ BH" 相同,因爲重複,所以顯示"BF/ BH"
"1”表的欄N (KH) 傳回"KH"表的 "$C$1" &  "$J$1", 兩者都是“噴油”相同,所以顯示“噴油”
"1”表的欄O (KP) 傳回"KP"表的  "$C$1" &  "$J$1", 兩者都是“噴油”相同,所以顯示“噴油”

對比.rar (15.59 KB)

1.png
2024-3-4 11:34
回復 1# 198188


    圖片是執行前及執行后效果,以及兩個資料庫 KP & KH。

TOP

回復 2# 198188


    謝謝前輩發表此主題與範例
請問[M5]裡的 BF/BH/BJ  ,這 BJ從何來?
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 3# Andy2483


    KH 資料表的 H1 儲存格

TOP

本帖最後由 Andy2483 於 2024-3-4 16:03 編輯

回復 1# 198188


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V$, Z, i&, T$, TT$, A, xA As Range, N%
Set Z = CreateObject("Scripting.Dictionary")
Set xA = Range([1!G1], [1!A65536].End(3))
xA.Offset(1, 12).ClearContents:  Brr = xA
For i = 2 To UBound(Brr)
   T = Format(Trim(Brr(i, 2)), "0000000"): V = Format(Val(Brr(i, 7)), "0000000"): TT = T & "/" & V
   Z(TT) = i
Next
Arr = [1!M1].Resize(UBound(Brr), 3)
A = Array(Range([KH!C1], [KH!A65536].End(3)), Range([KH!J1], [KH!H65536].End(3)), Range([KP!C1], [KP!A65536].End(3)), Range([KP!K1], [KP!I65536].End(3)))
For Each Crr In A
   Crr = Crr: N = N + 1
   For i = 3 To UBound(Crr)
      T = Format(Trim(Crr(i, 1)), "0000000"): V = Format(Val(Crr(i, 2)), "0000000"): TT = T & "/" & V
      If Z.Exists(TT) Then
         If Arr(Z(TT), 1) = "" Then
            Arr(Z(TT), 1) = Crr(1, 1)
            ElseIf InStr("/" & Arr(Z(TT), 1) & "/", "/" & Crr(1, 1) & "/") = 0 Then
            Arr(Z(TT), 1) = Arr(Z(TT), 1) & "/" & Crr(1, 1)
         End If
         Arr(Z(TT), N \ 3 + 2) = Crr(1, 3)
      End If
   Next
Next
[1!M1].Resize(UBound(Brr), 3) = Arr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 5# Andy2483


未命名1.png
2024-3-4 16:20

    運行VBA后,KP内是 H- J 欄沒有讀取出來,以至黃色部分不正確。
KP & KH 兩個表格堙A都有分別有兩份資料,欄 A - C   & 欄 H - J

TOP

回復 6# 198188


    前輩自己測試的範例與1#的範例不同,後學猜錯需求,請上傳真正的需求範例
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 198188 於 2024-3-4 18:20 編輯

1.png
2024-3-4 18:20
回復 7# Andy2483



規則是一樣的,不過第一範例可能看到效果沒有那麽清楚,所以上載第二範例,請以這個回復的圖片爲例

TOP

本帖最後由 Andy2483 於 2024-3-4 19:12 編輯

回復 8# 198188


    謝謝 前輩指導
原範例KP是IJK欄,請前輩試了解試改看看
Range([KP!K1], [KP!I65536].End(3))
改為
Range([KP!J1], [KP!H65536].End(3))
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2024-3-5 08:41 編輯

謝謝論壇,謝謝各位前輩
後學藉此帖複習了一下,方案註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V$, Z, i&, T$, TT$, A, xA As Range, N%
'↑宣告變數:&是長整數,%是短整數,$是字串變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Set xA = Range([1!G1], [1!A65536].End(3))
'↑令xA變數是區域儲存格(工作表 "1"裡的G1儲存格到 A欄最後有內容儲存格)
xA.Offset(1, 12).ClearContents:  Brr = xA
'↑令xA儲存格偏移下1列右12欄的區域儲存格內容清除,令Brr變數是以xA儲存格值帶入的二維陣列
For i = 2 To UBound(Brr)
'↑設順迴圈!令i從2 到Brr陣列縱向最大索引列號
   T = Format(Trim(Brr(i, 2)), "0000000"): V = Format(Val(Brr(i, 7)), "0000000"): TT = T & "/" & V
   '↑令T變數是i迴圈列2欄Brr陣列值去除頭尾空白字元後,轉化為7碼數值的字串,如果不足7碼則左側以0 補足
   '↑令V變數是i迴圈列7欄Brr陣列值轉化為數值後,再轉化為7碼數值的字串,如果不足7碼則左側以0 補足
   '↑令TT變數以"/"符號連接T與V變數所組成的新字串

   Z(TT) = i
   '↑令以TT變數為key,item是i變數(列號)納入Z字典中
Next
Arr = [1!M1].Resize(UBound(Brr), 3)
'↑令Arr變數是 工作表 "1"的M1儲存格擴展向下/向右區域儲存格值帶入的二維陣列
A = Array(Range([KH!C1], [KH!A65536].End(3)), Range([KH!J1], [KH!H65536].End(3)), Range([KP!C1], [KP!A65536].End(3)), Range([KP!K1], [KP!I65536].End(3)))
'↑令A變數是 4個區域儲存格的一維陣列
For Each Crr In A
'↑設逐項迴圈!令Crr變數是 A陣列裡的陣列值(區域儲存格)
   Crr = Crr: N = N + 1
   '↑令Crr變數轉變為 以Crr區域儲存格值帶入的二維陣列 (PS:Crr變數宣告是通用型變數,所以可以由儲存格變為二維陣列)
   For i = 3 To UBound(Crr)
   '↑設順迴圈!令i從3到Crr陣列縱向最大索引列號
      T = Format(Trim(Crr(i, 1)), "0000000"): V = Format(Val(Crr(i, 2)), "0000000"): TT = T & "/" & V
      '↑此標的為Crr陣列,T.V.TT變數意義同上
      If Z.Exists(TT) Then
      '↑如果Z字典裡有 TT變數的key?
         If Arr(Z(TT), 1) = "" Then
         '↑又如果Arr陣列裡(Z字典所記憶的列號1欄)陣列值是空字元?
            Arr(Z(TT), 1) = Crr(1, 1)
            '↑令該陣列值以 1列1欄Crr陣列值寫入
            ElseIf InStr("/" & Arr(Z(TT), 1) & "/", "/" & Crr(1, 1) & "/") = 0 Then
            '↑否則如果該陣列值沒有 1列1欄Crr陣列值
            Arr(Z(TT), 1) = Arr(Z(TT), 1) & "/" & Crr(1, 1)
            '↑令該陣列值是以 自身字串連接 1列1欄Crr陣列值所組成的新字串
         End If
         Arr(Z(TT), N \ 3 + 2) = Crr(1, 3)
         '↑令在Arr陣列裡寫入 1列3欄Crr陣列值
      End If
   Next
Next
[1!M1].Resize(UBound(Brr), 3) = Arr
'↑令工作表 "1"的M1儲存格擴展的範圍裡寫入Arr陣列值
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題