關鍵字查詢可改為VBA方式按鈕查詢 - Excel程式區

BV7BW

中學生 Rank: 2

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

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

11^# 跳轉到 »

發表於 2021-3-28 19:13 | 只看該作者

回復 10# samwang

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

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

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

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

12^#

發表於 2021-3-28 23:01 | 只看該作者

回復 10# samwang
S大大你好
回原操作工作表中.經測試後以可完全運作
有個問題是無法作保護工作表
卡在.Range(.[A4], .Cells(N + 3, 1)).NumberFormatLocal = "@"這裡
請S大在幫看看如何可用保護工作表操作
再請S大大可在程式後加注解
謝謝你

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

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

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

大學生 Rank: 4

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

14^#

發表於 2021-3-29 07:39 | 只看該作者

回復 samwang
S大大你好
回原操作工作表中.經測試後以可完全運作
有個問題是無法作保護工作表
卡在. ...
BV7BW 發表於 2021-3-28 23:01

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

TOP

samwang

大學生 Rank: 4

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

15^#

發表於 2021-3-29 07:43 | 只看該作者

回復 13# BV7BW

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

TOP

samwang

大學生 Rank: 4

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

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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

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

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

中學生 Rank: 2

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

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

19^#

發表於 2021-3-29 09:23 | 只看該作者

回復 17# jcchiang
謝謝J大大回應謝謝
現我再測試一下
第一版本是按下後整畫面沒有回應=當機
現我再以第2版本測試
再向你報告測試結果
再次謝謝你 J大大謝謝

敏而好學,不恥下問

TOP

BV7BW

中學生 Rank: 2

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

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

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]