Board logo

標題: [發問] 多筆EXCEL搜尋的用法-延伸問題 [打印本頁]
作者: mark15jill    時間: 2011-6-8 15:48     標題: 多筆EXCEL搜尋的用法-延伸問題

本帖最後由 mark15jill 於 2011-6-8 15:59 編輯

之前 有在此區 發問過 多筆excel搜尋
承蒙各位大大的礁島 有得到達到答案\
可是 現在產生一個問題
因當初 範例中 的地址 只有  台灣  和 美國
可是今天如果地址是    台灣台北 或者是 美國紐約的話
程式會無法判斷出來 進而全部空白
不知道是否有方式可以解決

以下是那篇的程式碼
  1. Private Sub 查詢()

  3.     Dim Text$, File$, TheSh As Object, Sh As Worksheet, Rng As Range, RngAddress$

  5.     With ThisWorkbook            '程式碼置於查詢總表.xls

  7.         Set TheSh = .Sheets("查詢")

  9.         TheSh.UsedRange.Offset(2).Clear

  11.         File = Dir(.Path & "\*年度*.xls")

  13.         Do While File <> ""

  15.         With Workbooks.Open(.Path & "\" & File)

  17.                 For Each Sh In .Sheets

  19.                     Set Rng = Sh.Range("F:F").Find(TheSh.TextBox1, LookAt:=xlWhole)

  21.                     If Not Rng Is Nothing Then

  23.                         RngAddress = Rng.Address

  25.                         With TheSh.Range("C" & Rows.Count).End(xlUp)

  27.                             .Offset(1, -2) = File

  29.                             .Offset(1, -1) = Sh.Name

  31.                         End With

  33.                     End If

  35.                     Do While Not Rng Is Nothing

  37.                         With TheSh.Range("C" & Rows.Count).End(xlUp)

  39.                             .Offset(1).Resize(1, 26) = Sh.Range(Sh.Cells(Rng.Row, "A"), Sh.Cells(Rng.Row, "Z")).Value

  41.                         End With

  43.                         Set Rng = Sh.Range("F:F").FindNext(Rng)

  45.                         If RngAddress = Rng.Address Then Exit Do

  47.                     Loop

  49.                 Next

  51.             .Close 0

  53.             End With

  55.             File = Dir

  57.         Loop

  59.     End With

  61. End Sub
複製代碼
ps 再延伸一個問題
如果今天 要用option控制項 去控制 他所要搜尋的欄位
如 程式的搜尋欄位預設 F 欄位
但是今天如果要 改搜尋  D欄位
那麼 OPTION控制項這部分要怎設定
有試著設定 但是會變成無法判讀(找不出來)
作者: Hsieh    時間: 2011-6-8 16:26

Set Rng = Sh.Range("D:D").Find(TheSh.TextBox1)
改成D欄模糊搜尋
作者: mark15jill    時間: 2011-6-8 16:37

回復 2# Hsieh


    版大
我把那行程式+在

                For Each Sh In .Sheets

                    ' 取消 Set Rng = Sh.Range("F:F").Find(TheSh.TextBox1, LookAt:=xlWhole)

                    Set Rng = Sh.Range("e:e").Find(TheSh.TextBox1)  '-版大的程式


                    If Not Rng Is Nothing Then


可是 結果還是一樣 空白
作者: luhpro    時間: 2011-6-8 22:39

本帖最後由 luhpro 於 2011-6-8 22:57 編輯
如果今天 要用option控制項 去控制 他所要搜尋的欄位
如 程式的搜尋欄位預設 F 欄位
但是今天如果要 改搜尋  D欄位
那麼 OPTION控制項這部分要怎設定
有試著設定 但是會變成無法判讀(找不出來)
mark15jill 發表於 2011-6-8 15:48

因為看不到你的實例, 所以我猜測那可能是因為你沒有給定初值, 或是值不正確,
亦或是選項增刪後會產生系統誤判(不能確定哪些算一組),
那麼我們可以自己控制實際執行的結果.

以下程式放在 ThisWorkbook :
Private Sub Workbook_Open()
  obD = True
  obe = False
  obF = False
End Sub

以下程式直接在設計模式下雙擊OptionButton以產生相關方法 Sub 頭尾, 中間放上個別值的設定程式即可
Private Sub obD_Click()
  obD = True
  obe = False
  obF = False
End Sub

Private Sub dbE_Click()
  obD = False
  obe = True
  obF = False
End Sub

Private Sub obF_Click()
  obD = False
  obe = False
  obF = True
End Sub

只要把握兩個重點 :
1. 程式開啟時記得設定一個 OptionButton 為 True, 其他則設為 False
2. 當使用者點擊某個 OptionButton 時應造成該 OptionButton 為 True, 其他則須設為 False
亦即不管系統會自動抓取到哪個,
我們自己來指定我們要哪個被選擇.
作者: mark15jill    時間: 2011-6-9 08:05

回復 4# luhpro


    抱歉 是我的疏忽><!!
因為有試著用if optionbutton1.value = 1 then 的方式下去 但是會造成 程式無法判讀的問題
已經附檔 這是原始的版本..


[attach]6547[/attach]
作者: Hsieh    時間: 2011-6-9 08:47

本帖最後由 Hsieh 於 2011-6-9 08:51 編輯

回復 5# mark15jill
  1. Sub ex()
  2. Dim Ar()
  3. Application.ScreenUpdating = False
  4. With Sheet1
  5. nd = IIf(.OptionButton1 = True, 2, IIf(.OptionButton2 = True, 5, 0))
  6. mystr = "*" & .TextBox1 & "*"
  7. If nd = 0 Then MsgBox "請選擇查詢項目": Exit Sub
  8. fs = Dir(ThisWorkbook.Path & "\*年度.xls")
  9. Do Until fs = ""
  10.    With Workbooks.Open(ThisWorkbook.Path & "\" & fs)
  11.      For Each Sh In .Sheets
  12.      With Sh
  13.      If Application.CountA(.Columns(nd)) = 0 Then GoTo 10
  14.         For Each a In .Columns(nd).SpecialCells(xlCellTypeConstants)
  15.         If a Like mystr Then
  16.            ReDim Preserve Ar(s)
  17.            Ar(s) = Array(fs, .Name, s + 1, .Cells(a.Row, 2).Value, .Cells(a.Row, 4).Value, .Cells(a.Row, 1).Value, .Cells(a.Row, 5).Value)
  18.            s = s + 1
  19.         End If
  20.         Next
  21. 10
  22.      End With
  23.      Next
  24.     .Close 0
  25.    End With
  26.    fs = Dir
  27. Loop
  28. If s > 0 Then
  29. .[A3:G65536] = ""
  30. .[A3].Resize(s, 7) = Application.Transpose(Application.Transpose(Ar))
  31. Else
  32. MsgBox "查無資料"
  33. End If
  34. End With
  35. Application.ScreenUpdating = True
  36. End Sub
複製代碼
作者: mark15jill    時間: 2011-6-9 09:03

本帖最後由 mark15jill 於 2011-6-9 11:21 編輯

回復 6# Hsieh


    版大 謝謝 可以用了>< 感恩感恩
新增選項的問題解決了~~
但是 還是不懂這行的意思...
nd = IIf(.OptionButton1 = True, 2, IIf(.OptionButton2 = True, 3, IIf(.OptionButton3 = True, 4, IIf(.OptionButton4 = True, 5, IIf(.OptionButton4 = True, 6, 16)))))
隱約知道說 true,2 是 第二欄位  可是 為什麼要那樣寫?? 不懂不董
如 true,6,16  是第16個欄位  但是 6是甚麼意思



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)