[發問] VBA 搜尋的問題

sss1159

HI，大家好

在網路上爬了一段時間，測了多種的做法還是沒找到理想的方式
在此詢問一下各位大大

有2個工作表
工作表1 = 存放各種資料的地方
工作表2 = 搜尋區

這邊需要2種方式:
1.
在工作表2 搜尋區 輸入要搜尋的資料【甲】
即可顯示 有關於【甲】的所有資料

2.
在工作表1 點選搜尋
會跳出彈窗 輸入【甲】
就會在工作表1 顯示所有關於 班級【甲】的資料

在點選 按鈕取消搜尋 即可恢復成原來的所有資料


在麻煩各位大大教導，謝謝

yen956

試試看:
Q1:

1. Private Sub CommandButton1_Click()
   
2.     Dim sCel As Range
   
3.     Dim inTxt, First1 As String
   
4.     Dim LastRow As Long
   
5.     Range("K2:N" & Rows.Count & "").ClearContents    '清除先前搜尋的資料"
   
6.     inTxt = InputBox("請輸入搜尋班級", "搜尋班級")
   
7.     If inTxt = "" Then Exit Sub                      '若使用者按 [取消] 則離開
   
8.     Set sCel = [A:A].Find(What:=inTxt, LookAt:=xlWhole)
   
9.     If sCel Is Nothing Then
   
10.         MsgBox ("未找到你要搜尋的班級"), vbCritical
    
11.         Exit Sub
    
12.     End If
    
13.     First1 = sCel.Address                       '保留第一個搜尋到的位址
    
14.     Do
    
15.         LastRow = Cells(Rows.Count, 11).End(xlUp).Row + 1
    
16.         sCel.Resize(1, 4).Copy Cells(LastRow, 11)
    
17.         Set sCel = [A:A].FindNext(sCel)        '尋找下一個
    
18.     Loop Until First1 = sCel.Address            '下一個的位置=第一個的位置(回到第一個的位置)
    
19. End Sub

複製代碼

Q2:

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim sh1, sh2 As Object
   
3.     Dim sCel As Range
   
4.     Dim First1 As String
   
5.     Dim LastRow As Long
   
6.     Set sh1 = Sheets("工作表1")
   
7.     Set sh2 = Sheets("工作表2")
   
8.     If Intersect(Target, sh2.[I1]) Is Nothing Then Exit Sub
   
9.     If Target = "" Then Exit Sub
   
10.     sh2.Range("H4:K" & sh2.Rows.Count & "").ClearContents    '清除先前搜尋的資料"
    
11.     sh1.Activate
    
12.     With sh1
    
13.         Set sCel = .[A:B].Find(What:=Target, LookAt:=xlPart)
    
14.         If sCel Is Nothing Then
    
15.             MsgBox ("未找到你要搜尋的資料"), vbCritical
    
16.             Exit Sub
    
17.         End If
    
18.         First1 = sCel.Address                          '保留第一個搜尋到的位址
    
19.         Do
    
20.             LastRow = sh2.Cells(sh2.Rows.Count, 8).End(xlUp).Row + 1
    
21.             sCel.Resize(1, 4).Copy sh2.Cells(LastRow, 8)
    
22.             Set sCel = .[A:B].FindNext(sCel)           '尋找下一個
    
23.         Loop Until First1 = sCel.Address               '下一個的位置=第一個的位置(回到第一個的位置)
    
24.     End With
    
25.     sh2.Activate
    
26. End Sub

複製代碼

sss1159

抱歉，這週末不在家，很晚才回覆您
非常感謝 yen956 大大


另外想再請問
1.
工作表1 點選搜尋 甲
即可在此工作表 直接列出 班級甲的所有資料

再點選 取消搜尋
即可恢復原本未搜尋前的資料

2.
套用大大個方法
我目前卡住了....目前多了一個工作表3
在工作表2想搜尋限定範圍
搜尋 甲
A~D欄 會顯示工作表1 甲的搜尋內容
H~K欄 會顯示工作表3 甲的搜尋內容

3.
如果 搜尋按鈕找不到資料，要在哪打上 [抱歉，找不到資料] 的語法呢



麻煩請指教，萬分感謝

sss1159

啊啊啊><
小妹搞錯了...上一則回覆 是用另一個方法....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh1, sh2 As Object
    Dim sCel As Range
    Dim First1 As String
    Dim LastRow As Long
    Set sh1 = Sheets("工作表1")
    Set sh2 = Sheets("工作表2")
    If Intersect(Target, sh2.[I1]) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    sh2.Range("H4:K" & sh2.Rows.Count & "").ClearContents    '清除先前搜尋的資料"
    sh1.Activate
    With sh1
        Set sCel = .[A:B].Find(What:=Target, LookAt:=xlPart)
        If sCel Is Nothing Then
            MsgBox ("未找到你要搜尋的資料"), vbCritical
            Exit Sub
        End If
        First1 = sCel.Address                          '保留第一個搜尋到的位址
        Do
            LastRow = sh2.Cells(sh2.Rows.Count, 8).End(xlUp).Row + 1
            sCel.Resize(1, 4).Copy sh2.Cells(LastRow, 8)
            Set sCel = .[A:B].FindNext(sCel)           '尋找下一個
        Loop Until First1 = sCel.Address               '下一個的位置=第一個的位置(回到第一個的位置)
    End With
    sh2.Activate
End Sub

想請問這段該怎麼使用呢..不知道為甚麼沒有巨集

Set sCel = [A:A].Find(What:=inTxt, LookAt:=xlWhole)

這段該怎麼去抓另一個工作表呢?

准提部林

回復 3# sss1159


〔工作表１〕
再點選 取消搜尋
即可恢復原本未搜尋前的資料

Ａ：Ｄ欄即是原本資料，搜尋並未動到此部份，何來〔恢復原本未搜尋前的資料〕？？？

sss1159

准提部林 大大您好

〔工作表１〕
再點選 取消搜尋
即可恢復原本未搜尋前的資料

Ａ：Ｄ欄即是原本資料，搜尋並未動到此部份，何來〔恢復原本未搜尋前的資料〕？？？

這方面是我描述的不好，在工作表1中，A:D欄 為資料區
當我點擊 搜尋-> 甲 會將資料塞選成 所有關於 班級甲的資料(會顯示在A:D欄)
當我查完班級甲的資料後，點選 取消搜尋 即可恢復原本未搜尋前的資料(一樣在A:D欄)

再麻煩指教了，萬分感謝:$

准提部林

回復 6# sss1159


Sub 篩選()
Dim X$
X = Application.InputBox("請輸入篩選關鍵字")
If X = "" Or X = "False" Then Exit Sub
With Range([A3], Cells(Rows.Count, 1).End(xlUp))
     If .Offset(1, 0).Find(X, Lookat:=xlPart) Is Nothing Then MsgBox "找不到資料!!": Exit Sub
    .AutoFilter Field:=1, Criteria1:="*" & X & "*"
End With
End Sub

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 篩選解除()
ActiveSheet.AutoFilterMode = False
End Sub

准提部林

＜工作表２＞　

Sub 搜尋()
Dim X$, R&, xSht As Worksheet, M, j&, Jm&, xH As Range
R = ActiveSheet.UsedRange.Rows.Count
If R > 3 Then Rows("4:" & R).Delete
X = Application.InputBox("請輸入搜尋關鍵字")
If X = "" Or X = "False" Then Exit Sub
For Each xSht In Sheets(Array("工作表1", "工作表3"))
　　Set xH = Range(Array("A4", "H4")(M))
　　M = M + 1: Jm = 0
　　With xSht
　　　　　For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　　If InStr(.Cells(j, 1) & .Cells(j, 2), X) Then
　　　　　　　　　Jm = Jm + 1
　　　　　　　　　.Cells(j, 1).Resize(1, 4).Copy xH(Jm)
　　　　　　　End If
　　　　　Next j
　　　　　If Jm = 0 Then MsgBox "〔" & .Name & "〕找不到〔" & X & "〕相關資料!!":
　　End With
Next
End Sub

sss1159

回復 8# 准提部林

實在是太感謝您了
想請教您這語法的意思是...看不太懂

1.

R = ActiveSheet.UsedRange.Rows.Count
If R > 3 Then Rows("4:" & R).Delete

這段是在 工作表2 算我表格前面留了多少列嗎?
如果我標題在行6 就改成 R>6 是這樣理解嗎?
後面的4是搜尋出來 資料顯示的起始欄位嗎?

2.

For Each xSht In Sheets(Array("工作表1", "工作表3"))
　　Set xH = Range(Array("A4", "H4")(M))

如果 我還有 工作表4 工作表5
直接改成
For Each xSht In Sheets(Array("工作表1", "工作表3","工作表4", "工作表5"))
　　Set xH = Range(Array("A4", "H4","O4", "U4")(M))
以此類推....??

3.

M = M + 1: Jm = 0
　　With xSht
　　　　　For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　　If InStr(.Cells(j, 1) & .Cells(j, 2), X) Then
　　　　　　　　　Jm = Jm + 1
　　　　　　　　　.Cells(j, 1).Resize(1, 4).Copy xH(Jm)
　　　　　　　End If

這段的4 要跟上面的

R > 3 Then Rows("4:" & R).Delete

一樣才能使用 是這樣吧?


再麻煩您指教下，非常感謝，努力學習中:$

准提部林

回復 9# sss1159


R = Range([A1], ActiveSheet.UsedRange).Rows.Count
＿請改成如上，以防〔標題列〕以上未使用，UsedRange會不包涵這範圍
If R > 3 Then Rows("4:" & R).Delete
＿〔標題列〕在第３列，若超過３才表示底下有資料，再清空

大凡表格結構會有〔表首〕〔標題列〕〔資料明細〕，皆以〔標題列〕為區隔線

這段是指要載入查詢資料的工作表，亦即執行vba的〔當前頁〕