返回列表 上一主題 發帖

依據單別+廠別,利用公式判斷,儲位是否正確

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 2021-11-25 12:04 | 顯示全部帖子
回復 1# VANESSA

請測試看看，謝謝
另外檢查小表要加入其他單資訊如照片，您提供答案有2筆錯誤如照片

Sub test()
Dim Arr, xD, T$, pos%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([j5], [g65536].End(3))
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 2)
    xD(T) = Array(Arr(i, 3), Arr(i, 4))
Next
Arr = Range([d1], [a65536].End(3))
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        pos = InStr(xD(T)(0), Arr(i, 2))
        If pos = 0 Then
            Arr(i, 4) = "錯誤，因為" & Arr(i, 1) & "+" & Arr(i, 3) & "，儲位" & xD(T)(1)
        Else
            Arr(i, 4) = "正確，因為" & Arr(i, 1) & "+" & Arr(i, 3) & "，儲位" & xD(T)(1)
        End If
    End If
Next
Range("a1").Resize(UBound(Arr), 4) = Arr
End Sub

1.JPG (166.82 KB)

1.JPG

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 2021-11-25 15:13 | 顯示全部帖子
回復 1# VANESSA

您提供答案有2筆錯誤>> 更正2#，您的答案是正確，更新如下，謝謝

Sub test2()
Dim Arr, xD, T$, pos%, a, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([j5], [g65536].End(3))
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 2)
    xD(T) = Array(Arr(i, 3), Arr(i, 4))
Next
Arr = Range([d1], [a65536].End(3))
For i = 2 To UBound(Arr)
    T = Arr(i, 1) & "|" & Arr(i, 3)
    If xD.Exists(T) Then
        a = Split(xD(T)(0), ".")
        For j = 0 To UBound(a)
            If Arr(i, 2) = a(j) Then pos = 1
        Next
        If pos = 0 Then
            Arr(i, 4) = "錯誤，因為" & Arr(i, 1) & "+" & Arr(i, 3) & "，儲位" & xD(T)(1)
        Else
            Arr(i, 4) = "正確，因為" & Arr(i, 1) & "+" & Arr(i, 3) & "，儲位" & xD(T)(1)
            pos = 0
        End If
    End If
Next
Range("a1").Resize(UBound(Arr), 4) = Arr
End Sub

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
返回列表 上一主題