標題: VBA比對求解 [打印本頁]

---

作者: peter631114    時間: 2019-6-13 17:38     標題: VBA比對求解

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

[attach]30851[/attach]

[attach]30852[/attach]

---

作者: n7822123    時間: 2019-6-14 01:39

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

回復 1# peter631114


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

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

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

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

是這個邏輯?

---

作者: n7822123    時間: 2019-6-14 02:26

本帖最後由 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

---

作者: peter631114    時間: 2019-6-14 10:22

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

---

作者: n7822123    時間: 2019-6-14 11:09

回復 4# peter631114


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

[attach]30855[/attach]

[attach]30856[/attach]

---

作者: peter631114    時間: 2019-6-14 13:26

Dear Sir

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

[attach]30859[/attach]
[attach]30860[/attach]

---

作者: 准提部林    時間: 2019-6-14 17:59

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


這要如何比對??

==============

---

作者: peter631114    時間: 2019-6-17 10:22

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

[attachimg]30884[attach]30885[/attach]
[/attachimg]

---

作者: 准提部林    時間: 2019-6-17 20:10

回復 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

[attach]30888[/attach]


======================

---

作者: peter631114    時間: 2019-6-18 10:16

謝謝大大的幫忙,感恩喔

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)