[發問] 關鍵字查詢可改為VBA方式按鈕查詢

BV7BW

各位新進.老師.大家好
我在網路上學習關鍵字查詢用法
其缺點是公式裸露.容易誤觸消除.
是否可改用VBA寫法
按鈕式查詢
關鍵字vba.zip (17.26 KB)

下載次數: 33

2021-3-24 18:24

jcchiang

回復 1# BV7BW

試試看
  Sub ex()
Dim arr As Variant, a As Object, X%
Set arr = Sheets("工作表3").Range(Sheets("工作表3").[F2], Sheets("工作表3").[d2].End(4))
With Sheets("工作表2")
   For Each a In .Range(.[a4], .[a4].End(4))
      For X = 1 To arr.Rows.Count
         If a = Int(Replace(arr(X, 1), "A", "") - 100) Then
            a.Offset(, 1).Resize(, 3) = Application.Transpose(Application.Transpose(arr(X, 1).Resize(, 3)))
            Exit For
         End If
      Next
   Next
End With
End Sub

samwang

回復 1# BV7BW

請測試看看，謝謝。
Sub tt()
Dim Arr, xD, i&, N%, T
Set xD = CreateObject("Scripting.Dictionary")
Sheets("工作表2").Range("b4:d200") = ""
Arr = Range([工作表3!F1], [工作表3!D65536].End(3))
For i = 2 To UBound(Arr)
    T = Int(Replace(Arr(i, 1), "A", "") - 100)
    xD(T & "") = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3))
Next
Arr = Range([工作表2!D3], [工作表2!A65536].End(3))
For i = 2 To UBound(Arr)
    If xD.Exists(Arr(i, 1) & "") Then
        Arr(i, 2) = xD(Arr(i, 1) & "")(0)
        Arr(i, 3) = xD(Arr(i, 1) & "")(1)
        Arr(i, 4) = xD(Arr(i, 1) & "")(2)
        N = N + 1
    End If
Next
If N > 0 Then Sheets("工作表2").[A3].Resize(N, 4) = Arr
End Sub

BV7BW

謝謝.J大.S大2位指點
徹試後再跟2位報告
謝謝你們

BV7BW

回復 2# jcchiang
S大大 你好
感謝你所提供程式.經演練.會當機
故無法向你提出報告
可因我細說不全
再度向你提出說明如下

序號=IF(B4="","",TEXT(ROW()-3,"00"))
(序號)只是數字不特定意義.是讓使用人知道有幾個相同項編.項目.位置.所以可無可有.也可省列
因所需查詢繁多或是單一數.等查詢後出現資料再加以序號.不能全先填上數字.所本例是因前述程式所需先行輸入100格

項編(B3).項目(C3).位置(D3).則以C2格為查詢來源關鍵字
當符合工作表"C2"內關鍵字.則在工作表"B4"."C4"."D4".中呈現.多數關鍵字時.則往下排序

1)如工作表2"C2"打上"我"則在工作表3"中"D"."E"."F"作查詢比對.符合有"我"字則回傳至工作表2中"B"."C"."D"呈列完成
因在工作表3中所查詢"我".是在工作表3"E"欄找出.所以回傳至工作表2"C4"欄
另工作表2"B4""D4"則以工作表3中所查詢列中"D"."F"作完全對照比對回傳至工作表2"B4""D4"呈列

2)相同如在工作表2"C2"打上"A101".則在工作表3中"D"."E"."F"作查詢符合有A101.則回傳至工作表2中"B"."C"."D".呈列完成
因在工作表3中所查詢"A101".是在工作表3"D"欄找出.所以回傳至工作表2"B4"欄
另工作表2"C4""D4"則以工作表3中所查詢列中"E"."F"作完全對照比對回傳至工作表2"C4""D4"呈列

3)如同在工作表2"C2"打上"甲".則在工作表3中"D"."E"."F"作查詢符合有"甲".則回傳至工作表2中"B"."C"."D".呈列完成
因在工作表3中所查詢"甲".是在工作表3"F"欄找出.所以回傳至工作表2"D4"欄
另工作表2"B4""C4"則以工作表3中所查詢列中"D"."E"作完全對照比對回傳至工作表2"B4""C4"呈列

同樣假如工作表2"B4"經對照比對後乃然空字.則就是空字."C"."D"也是同樣

*關鍵是在工作表2"C2"去對照比對.工作表3"D"."E"."F"欄.後再回傳到工作表2"B4"."C4"."D4".並往下排序*

BV7BW

回復 3# samwang
s大大 你好
感謝你所提供程式.向你報告過程
經演練後.只能查詢1次且回傳會有間隔
例如在工作表"C2"中輸入"我"
所呈現是把工作表3完全覆製到工作表2中

可因我細說不全
再度向你提出說明如下

序號=IF(B4="","",TEXT(ROW()-3,"00"))
(序號)只是數字不特定意義.是讓使用人知道有幾個相同項編.項目.位置.所以可無可有.也可省列
因所需查詢繁多或是單一數.等查詢後出現資料再加以序號.不能全先填上數字.所本例是因前述程式所需先行輸入100格

項編(B3).項目(C3).位置(D3).則以C2格為查詢來源關鍵字
當符合工作表"C2"內關鍵字.則在工作表"B4"."C4"."D4".中呈現.多數關鍵字時.則往下排序

1)如工作表2"C2"打上"我"則在工作表3"中"D"."E"."F"作查詢比對.符合有"我"字則回傳至工作表2中"B"."C"."D"呈列完成
因在工作表3中所查詢"我".是在工作表3"E"欄找出.所以回傳至工作表2"C4"欄
另工作表2"B4""D4"則以工作表3中所查詢列中"D"."F"作完全對照比對回傳至工作表2"B4""D4"呈列

2)相同如在工作表2"C2"打上"A101".則在工作表3中"D"."E"."F"作查詢符合有A101.則回傳至工作表2中"B"."C"."D".呈列完成
因在工作表3中所查詢"A101".是在工作表3"D"欄找出.所以回傳至工作表2"B4"欄
另工作表2"C4""D4"則以工作表3中所查詢列中"E"."F"作完全對照比對回傳至工作表2"C4""D4"呈列

3)如同在工作表2"C2"打上"甲".則在工作表3中"D"."E"."F"作查詢符合有"甲".則回傳至工作表2中"B"."C"."D".呈列完成
因在工作表3中所查詢"甲".是在工作表3"F"欄找出.所以回傳至工作表2"D4"欄
另工作表2"B4""C4"則以工作表3中所查詢列中"D"."E"作完全對照比對回傳至工作表2"B4""C4"呈列

同樣假如工作表2"B4"經對照比對後乃然空字.則就是空字."C"."D"也是同樣

*關鍵是在工作表2"C2"去對照比對.工作表3"D"."E"."F"欄.後再回傳到工作表2"B4"."C4"."D4".並往下排序*

BV7BW

回復 2# jcchiang
抱歉
J大大
我把你名稱說錯.請你原諒
感謝你所提供程式.經演練會當機

BV7BW

回復 3# samwang
剛忘少傳檔案
現在補上
關鍵字vba修改.zip (26.81 KB)

下載次數: 17

2021-3-27 16:21

BV7BW

回復 3# samwang
剛忘少傳檔案
現在補上

samwang

回復 8# BV7BW


請再測試看看，感謝。
Sub tt1()
Dim Arr, i&, N%, T, pos%, pos2%, pos3%
Sheets("工作表2").Range("A4:D1000") = ""
T = [工作表2!C2]
Arr = Range([工作表3!G1], [工作表3!D65536].End(3))
For i = 2 To UBound(Arr)
    pos = InStr(Arr(i, 1), T): pos2 = InStr(Arr(i, 2), T)
    pos3 = InStr(Arr(i, 3), T)
    If pos > 0 Or pos2 > 0 Or pos3 > 0 Then
        N = N + 1: Arr(N, 1) = Format(N, "00")
        For j = 2 To 4: Arr(N, j) = Arr(i, j - 1): Next
    End If
Next
If N > 0 Then
    With Sheets("工作表2")
        .Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@"
        .[A4].Resize(N, 4) = Arr
    End With
End If
End Sub