跨欄對比

有三個表格，在表格“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)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

38^#

發表於 2024-3-5 18:38 | 只看該作者

回復 37# 198188

Crr(1, 3) 改為 Crr(i, 3). 試試看

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188

中學生 Rank: 2

帖子: 405
主題: 58
精華: 0
積分: 489
點名: 25
作業系統: win7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-5-10

37^#

發表於 2024-3-5 17:55 | 只看該作者

回復 36# Andy2483

測試過，答案沒有問題。
另外有個問題，請問 "噴油" 是讀取 KP & KH 工作表内 C1 & J1 的儲存格嗎？我測試過好像不是，請問程式哪個位置是操作這個的？
因爲有兩種選擇 “ 噴油” 和 “不噴油”，我想看看能不能自己修改一下。
或者能否像帖子裏的圖片，第一欄模號，第二欄長度，第三欄 “噴油” 或者空白，然後直接讀取第三欄的數據。

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

36^#

發表於 2024-3-5 15:42 | 只看該作者

回復 35# 198188
謝謝前輩指導,請再試試看
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V$, Z, Q, i&, T$, TT$, A, xA As Range, N%, C%
Set Z = CreateObject("Scripting.Dictionary")
Set xA = Range(ActiveSheet.[G1], ActiveSheet.[B65536].End(3)(1, 0))
xA.Offset(1, 12).Resize(, 3).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) = Z(TT) & "/" & i
Next
Arr = ActiveSheet.[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!J1], [KP!H65536].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
      Q = Split(Z(TT) & "/", "/")
      For C = 1 To UBound(Q) - 1
         If Arr(Q(C), 1) = "" Then
            Arr(Q(C), 1) = Crr(1, 1)
            ElseIf InStr("/" & Arr(Q(C), 1) & "/", "/" & Crr(1, 1) & "/") = 0 Then
            Arr(Q(C), 1) = Arr(Q(C), 1) & "/" & Crr(1, 1)
         End If
         Arr(Q(C), N \ 3 + 2) = Crr(1, 3)
      Next
   End If
Next
Next
ActiveSheet.[M1].Resize(UBound(Brr), 3) = Arr
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188