返回列表 上一主題 發帖

[發問] 比對輸入的資料,並篩選至各對應資料行

[發問] 比對輸入的資料,並篩選至各對應資料行

請問我要篩選出各對應資料後分別填入代號
鍵入需要查詢的字碼後,再比對[C/D/E行]分類,並列出其符合的字碼
1.比對[A行]並在[G行]列出相符[C行]的字碼,但排除[E行]的字碼
2.比對[A行]並在[D行]列出相符[I行]的字碼
3.[A行]比對[C/D/E行]的字碼,在[G行]列出不相符的字碼
擷取.PNG
2021-9-9 15:00

以上三種比對有點雜,有點想不通
再請站上的前輩們可以幫忙看看
感謝~
比對用.rar (36.37 KB)

回復 1# jackson7015

請測試看看,謝謝

Sub test()
Dim Arr, Brr(), xD, xD1, T$, AR%, BR%, DR%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
R = Columns("C:E").Find("*", SearchDirection:=xlPrevious).Row
Arr = Range("C1:E" & R)
For j = 1 To 3: For i = 2 To UBound(Arr)
T = Arr(i, j): xD(T & "_" & j) = 1: xD1(T) = 1
Next i: Next j
Arr = Range([a1], [a65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 1): N = xD1(T)
    If N <> 1 Then DR = DR + 1: Brr(DR, 1) = T: GoTo 99
    For j = 1 To 2
        If xD.Exists(T & "_" & j) Then
            If j = 1 Then
                If Not xD.Exists(T & "_3") Then
                    AR = AR + 1: Brr(AR, 2) = T
                End If
            Else
                BR = BR + 1: Brr(BR, 3) = T
            End If
        End If
    Next
99: Next
Range("g2").Resize(UBound(Brr), 3) = Brr
End Sub

TOP

Sub TEST_A1()
Dim Arr, Brr, xD, T$, i&, j%, N&(4)
Set xD = CreateObject("Scripting.Dictionary")
For j = 1 To 3
    Arr = Range(Cells(1, j + 2), Cells(Rows.Count, j + 2).End(xlUp))
    For i = 2 To UBound(Arr)
        If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = j
    Next i
Next j
'----------------------------------
Arr = Range([a1], Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
    T = Arr(i, 1): If T = "" Then GoTo i01
    j = xD(T) + 1: N(j) = N(j) + 1
    Brr(N(j), j) = T
i01: Next i
[g2].Resize(UBound(Brr), 3) = Brr
End Sub

TOP

        靜思自在 : 生氣,就是拿別人的過錯來懲罰自己。
返回列表 上一主題