samwang

回復 1# ziv976688


很難理解您的需求，可以解釋詳細一點嗎? 謝謝

samwang

回復 5# ziv976688


看到您可以寫到這樣真的好厲害，看得都眼花，我會試著解讀您的意思，謝謝

samwang

回復 7# ziv976688

請先測試看看是否為您的需求，下面只是準2進3，如果沒問題請您自行修改程式給其它工作表，感謝。

Sub 準2進3()
Dim Arr, Arr1, Brr, xD, xD1, T, T1, k%, i&, j&
Arr = Range([ae2], [ak65536].End(3))    '資料裝入數組
Arr1 = Range([an2], [at65536].End(3))   '資料裝入數組
ReDim Brr(1 To UBound(Arr), 1 To 7)     '預設答案數組
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
'將數組的最後一列資料裝到字典
For i = UBound(Arr) To UBound(Arr)
    For j = 1 To 7: xD(Arr(i, j) & "") = "": Next
Next
For i = UBound(Arr1) To UBound(Arr1)
    For j = 1 To 7: xD1(Arr1(i, j) & "") = "": Next
Next
'開始比對
For i = 1 To UBound(Arr): For j = 1 To UBound(Arr, 2)
    T = Arr(i, j): T1 = Arr1(i, j)
    For k = 0 To 48
        a = (T + k) Mod 49: a1 = (T1 + k) Mod 49            'a:MOD(AE2+k,49)的餘數
        If xD.Exists(a & "") And xD1.Exists(a1 & "") Then   '2邊餘數都有在各別字典
            If Brr(i, j) = "" Then                          '將k裝入Brr
                Brr(i, j) = k
            Else
                Brr(i, j) = Brr(i, j) & "," & k
            End If
        End If
    Next
Next: Next
Range("V2").Resize(UBound(Brr), 7) = Brr
End Sub

samwang

回復 7# ziv976688

更新#8樓程式 -1 因為最後一筆不用比對，謝謝
   
'開始比對
For i = 1 To UBound(Arr)-1

samwang

回復 10# ziv976688


請先確認是否您的需求，如果是正確無誤，剩下其它工作表就簡單了，謝謝

samwang

回復 15# ziv976688


請再測試看看，謝謝

samwang

回復 12# 准提部林


准大寫的很太精簡，只用了一個數組和字典就搞定多個工作表資料，之前已有看過字典同時裝入不一樣的資料
這次又學到數組也可以這樣使用，真的是一個很好的範例學習了，感謝分享。