BV7BW

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-3-24 18:28 | 只看該作者

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

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

關鍵字vba.zip (17.26 KB)

樓主熱帖

敏而好學,不恥下問

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

2^#

發表於 2021-3-25 09:02 | 只看該作者

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

3^#

發表於 2021-3-25 11:49 | 只看該作者

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

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

4^#

發表於 2021-3-25 12:51 | 只看該作者

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

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

5^#

發表於 2021-3-27 15:53 | 只看該作者

回復 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".並往下排序*

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

6^#

發表於 2021-3-27 16:05 | 只看該作者

回復 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".並往下排序*

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

7^#

發表於 2021-3-27 16:08 | 只看該作者

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

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

8^#

發表於 2021-3-27 16:21 | 只看該作者

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

關鍵字vba修改.zip (26.81 KB)

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

帖子: 199
主題: 22
精華: 0
積分: 233
點名: 227
作業系統: Vista
軟體版本: Office2003
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2020-4-14
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章

9^#

發表於 2021-3-27 16:21 | 只看該作者

本帖最後由 BV7BW 於 2021-3-27 16:23 編輯

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

敏而好學,不恥下問

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

10^#

發表於 2021-3-28 18:09 | 只看該作者

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

TOP