返回列表 上一主題 發帖

VBA比對求解

VBA比對求解

Dear各位版大與高手
這邊有一個比對的問題,想請高手幫忙撰寫,其問題如下圖

Snap1.jpg
2019-6-13 17:35


測試1.rar (18.39 KB)

本帖最後由 n7822123 於 2019-6-14 01:41 編輯

回復 1# peter631114


如果[B2]=[B6],是不是[K5]=[A2] ,[M5]=[A6]

然後繼續看[B2]是否等於[B7],

等於的話繼續用[B2]比下一個[B8],直到比完都一樣,再換[B3]?

不等於的話,跳到[B3]去跟其他的比

是這個邏輯?
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2019-6-14 02:28 編輯

回復 1# peter631114


希望我的理解沒有錯,請試試看吧!

Sub 比對()
Dim Ri&, Rn&, i&, j&, n&, Arr, Brr
Ri = Cells(Rows.Count, 1).End(3).Row
Arr = [A2].Resize(Ri - 1, 2)
Rn = Ri * (Ri - 1)
If Rn >= Rows.Count Then Rn = Rows.Count - 1
Brr = [K2].Resize(Rn, 3): n = 1
For i = 1 To Ri - 1: For j = 1 To Ri - 1
  If i <> j Then
      If Arr(i, 2) = Arr(j, 2) Then
        Brr(n, 1) = Arr(i, 1)
        Brr(n, 3) = Arr(j, 1)
        n = n + 1
      Else: Exit For: End If
  End If
Next:  Next
[K2].Resize(Rn, 3) = Brr
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

Dear Sir
如你所了解沒有錯,我試用了你的code進行測試,結果是對的~~只是目前程式只有比對到判斷條件為0的部分,當判斷條件為"1"或2以後就沒有比對了~~

TOP

回復 4# peter631114


  不太懂你的意思,我程式跑出來的結果,跟你的敘述是一樣的

比對.png
2019-6-14 11:08


比對.rar (19.93 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

Dear Sir

請參考下圖所示,程式會一直判斷,直到B欄位為空白才會停止
謝謝你的大力幫忙

Snap2.jpg
2019-6-14 13:25

0614_比對.rar (18.65 KB)

TOP

類別        判斷條件
A        0
B        0
C        0
D        2
F        2
G        2
H        0
I        0
J        2
K        2
L        2


這要如何比對??

==============
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

Dear大大
請參考下圖比對結果,詳細內容請參考附件

[attachimg]30884 0617比對結果.rar (6.79 KB)
[/attachimg]
Snap3.jpg

TOP

回復 8# peter631114


Sub TEST()
Dim Arr, Brr, i&, j&, N&
Arr = Range([B1], Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To 20000, 1 To 3)
For i = 2 To UBound(Arr)
    For j = 2 To UBound(Arr)
        If i <> j And Arr(i, 2) = Arr(j, 2) Then
           N = N + 1
           Brr(N, 1) = Arr(i, 1)
           Brr(N, 3) = Arr(j, 1)
        End If
    Next j
Next i
If N = 0 Then Exit Sub
[F2:H2].Resize(N) = Brr
End Sub

Xl0000362.rar (12.25 KB)


======================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

謝謝大大的幫忙,感恩喔

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題