12345
返回列表 上一主題 發帖

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

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
11# 跳轉到 »
發表於 2021-3-28 19:13 | 只看該作者
回復 10# samwang

謝謝s大
完全符合工作需求
我先理解一下
可有一些不懂地方想請s大大再幫注解
感謝s大   謝謝
敏而好學,不恥下問

TOP

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
12#
發表於 2021-3-28 23:01 | 只看該作者
回復 10# samwang
S大 大你好
回原操作工作表中.經測試後以可完全運作
有個問題是無法作保護工作表
卡在.Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@"這裡
請S大在幫看看如何可用保護工作表操作
再請S大大可在程式後加注解
謝謝你
敏而好學,不恥下問

TOP

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
13#
發表於 2021-3-29 07:08 | 只看該作者
回復 10# samwang
S大大 你好
我已成功利用這2組程式
Worksheets("工作表2").Unprotect ("0123")
Sheets("工作表2").Protect ("0123")
去做保護動作
但我很想知道程式註解尤其是這段
.Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@"
我再理解會比較慢.如有你註解可加速融通
再次謝謝 s大指導 謝謝
敏而好學,不恥下問

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
14#
發表於 2021-3-29 07:39 | 只看該作者
回復  samwang
S大 大你好
回原操作工作表中.經測試後以可完全運作
有個問題是無法作保護工作表
卡在. ...
BV7BW 發表於 2021-3-28 23:01


執行前可以先解開保護，執行完畢後可再加入保護，謝謝

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
15#
發表於 2021-3-29 07:43 | 只看該作者
回復 13# BV7BW


那段的意思是將工作表2的A欄有資料的序號改為文字格式，謝謝。

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
16#
發表於 2021-3-29 07:55 | 只看該作者
回復 13# BV7BW


Sub tt1()
Dim Arr, i&, N%, T, pos%, pos2%, pos3%
Sheets("工作表2").Range("A4:D1000") = "" '清除工作表2的資料
T = [工作表2!C2]   '查找字
Arr = Range([工作表3!G1], [工作表3!D65536].End(3)) '將工作表3資料D~G欄位資料放在數組中
For i = 2 To UBound(Arr)
     pos = InStr(Arr(i, 1), T): pos2 = InStr(Arr(i, 2), T)
     pos3 = InStr(Arr(i, 3), T)        '查詢字確認有無在工作表3的D、E、F欄
     If pos > 0 Or pos2 > 0 Or pos3 > 0 Then  '有找到時
         N = N + 1: Arr(N, 1) = Format(N, "00")     '有資料時Arr的第1欄位，自動產生序號
         For j = 2 To 4: Arr(N, j) = Arr(i, j - 1): Next '將工作表3資料D、E、F欄資料暫時存放在Arr
     End If
Next
If N > 0 Then '確認有無找到資料
     With Sheets("工作表2")
         .Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@" 'A欄改為文字格式
         .[A4].Resize(N, 4) = Arr '有找到資料救回填至工作表2
     End With
End If
End Sub

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
17#
發表於 2021-3-29 08:50 | 只看該作者
回復 7# BV7BW

原程式測試時並無當機問機,所以不了解你所說會當機是什麼問題
只是原程式不知道判斷條件是以Sheets("工作表2").[C2]為主
修改後程式如下
  Sub ex()
Dim X$, a As Variant, c As Variant
Set c = Nothing
Sheets("工作表2").Range([b4], [b4].End(4).Resize(, 3)).ClearContents
X = Sheets("工作表2").[C2]
For Each a In Sheets("工作表3").Range([工作表3!D2], [工作表3!D2].End(4))
   If a = X Or a.Offset(, 1) Like "*" & X & "*" Or a.Offset(, 2) = X Then  '判斷是否有符合條件
      If c Is Nothing Then
         Set c = a.Resize(, 3)
      Else
         Set c = Union(c, a.Resize(, 3))
      End If
   End If
Next
c.Copy Sheets("工作表2").[b4].Resize(, 3)
End Sub

TOP

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
18#
發表於 2021-3-29 09:12 | 只看該作者
回復 16# samwang
感謝 S 大大先進 勞心指導 謝謝你
現整組程式已完全可理解也可正常運作
先前不能保護動作.以加上鎖定即解除動作.如下
Sub tt1()
Worksheets("工作表2").Unprotect ("0123")   '保護工作表2
Dim Arr, i&, N%, T, pos%, pos2%, pos3%
Sheets("工作表2").Range("A4:D1000") = ""   '清除工作表2的資料
T = [工作表2!C2]     '查找字
Arr = Range([工作表3!G1], [工作表3!D65536].End(3))   '將工作表3資料D~G欄位資料放在數組中
For i = 2 To UBound(Arr)
     pos = InStr(Arr(i, 1), T): pos2 = InStr(Arr(i, 2), T)
     pos3 = InStr(Arr(i, 3), T)        '查詢字確認有無在工作表3的D、E、F欄
     If pos > 0 Or pos2 > 0 Or pos3 > 0 Then    '有找到時
         N = N + 1: Arr(N, 1) = Format(N, "00")     '有資料時Arr的第1欄位，自動產生序號
         For j = 2 To 4: Arr(N, j) = Arr(i, j - 1): Next   '將工作表3資料D、E、F欄資料暫時存放在Arr
     End If
Next
If N > 0 Then   '確認有無找到資料
     With Sheets("工作表2")
         .Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@"   'A欄改為文字格式
         .[A4].Resize(N, 4) = Arr   '有找到資料救回填至工作表2
     End With
End If
Sheets("工作表2").Protect ("0123")   '取消保護工作表2
End Sub
敏而好學,不恥下問

TOP

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
19#
發表於 2021-3-29 09:23 | 只看該作者
回復 17# jcchiang
謝謝J大大回應謝謝
現我再測試一下
第一版本是按下後整畫面沒有回應=當機
現我再以第2版本測試
再向你報告測試結果
再次謝謝你  J大大 謝謝
敏而好學,不恥下問

TOP

BV7BW

帖子
200 
主題
22 
精華
0 
積分
234 
點名
34  
作業系統
Vista 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2020-4-14 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章論壇榮譽勳章論壇贊助勳章
20#
發表於 2021-3-29 16:27 | 只看該作者
回復 19# BV7BW
J大大 你好
第2版本經測試後
1)可正常運作所需查詢動作
有1點是無法再用"B"欄查詢
可說用A101就可查詢.如用A就不可行.出現錯誤*c.Copy Sheets("工作表2").[b4].Resize(, 3)*
在"C"."D"欄中就可以.如"D"欄輸入"高"就可查詢運作
2)當我轉換至實際使用工作表時
會出現錯誤*Sheets("工作表2").Range([b4], [b4].End(4).Resize(, 3)).ClearContents*
往下就無法再測試
再請問工作表3中"A""B""C"欄在程式中有用途.或是有需要?
在這裡先向J大大 說 非常感謝
讓我再多一層深入
可請J大大再幫程式注解
非常謝謝你
附上測試檔
關鍵字vba修改 - 複製.zip (130.91 KB)
敏而好學,不恥下問

TOP

        靜思自在 : 不怕事多，只怕多事。
12345
返回列表 上一主題