Qin

回復 28# Kubi
   哎呀! 腦袋卡住了, 忘了模組..
    幸好以上問題解決了.

    在"temp"的隱藏功能

Qin

奇怪, 為何留言不能完全顯示???

准提部林

回復 30# Qin

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
     If .Address = "$C$1" Then
        Cancel = True
        If [B1] = "" Then MsgBox "未輸入搜尋文字！ ", 0 + 16: Exit Sub
        Call 搜尋(Array([B1], "", ""), Array(6, 7, 4))
        .Interior.ColorIndex = 6: [B1].Interior.ColorIndex = 6
     ElseIf .Address = "$C$2" Then
        Cancel = True
        If [B2] = "" Then MsgBox "未輸入搜尋文字！ ", 0 + 16: Exit Sub
        Call 搜尋(Array("", [B2], ""), Array(6, 7, 4))
        .Interior.ColorIndex = 6: [B2].Interior.ColorIndex = 6
     ElseIf .Address = "$C$3" Then
        Cancel = True
        If [B3] = "" Then MsgBox "未輸入搜尋文字！ ", 0 + 16: Exit Sub
        Call 搜尋(Array("", "", [B3]), Array(6, 7, 4))
        .Interior.ColorIndex = 6: [B3].Interior.ColorIndex = 6
     ElseIf .Address = "$A$1:$A$3" Then
        Cancel = True
        If [B1] & [B2] & [B3] = "" Then MsgBox "未輸入搜尋文字！ ", 0 + 16: Exit Sub
        Call 搜尋(Array([B1], [B2], [B3]), Array(6, 7, 4))
        .Interior.ColorIndex = 6: [B1:B3].Interior.ColorIndex = 6
     End If
End With
End Sub

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 搜尋(Ur1, Ur2)
Dim Sht As Worksheet, xU As Range, xE As Range, k%
Call 清除
For Each Sht In Sheets
    If Left(Sht.Name, 4) <> "Data" Then GoTo 101
    If Sht.FilterMode Then Sht.ShowAllData
    Set xU = Sht.UsedRange
    For k = 0 To 2
        If Ur1(k) <> "" Then
           xU.AutoFilter Field:=Ur2(k), Criteria1:=Ur1(k)
        End If
    Next k
    Set xE = Cells(Rows.Count, 1).End(xlUp)(2)
    If xE.Row < 6 Then Set xE = [A6]
    xU.Offset(1, 0).Copy xE
    Sht.AutoFilterMode = False
101: Next
Set xE = Cells(Rows.Count, 1).End(xlUp)
If xE.Row < 6 Then MsgBox "找不到符合的資料！ ": Exit Sub
[A6:J6].Interior.ColorIndex = 35
[A7:J7].Interior.ColorIndex = 6
[A6:J7].Copy
Range(xE, [J6]).PasteSpecial Paste:=xlFormats
xE(2).EntireRow.Delete
[A6].Select
End Sub

Sub 清除()
With Sheets("Search")
     If .FilterMode Then .ShowAllData
     With .UsedRange.Offset(5, 0)
          .ClearContents
          .Interior.ColorIndex = xlNone
     End With
     .[A1,C1:C3].Interior.ColorIndex = 15
     .[B1:B3].Interior.ColorIndex = 35
     .[A6].Select
End With
End Sub
　
　

准提部林

改一下[雙擊觸發]部份:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim T1$, T2$, T3$, R As Range, C%
With Target
     Select Case .Item(1).Address(0, 0)
       Case "C1": T1 = [B1]: Set R = [B1]: C = 1
       Case "C2": T2 = [B2]: Set R = [B2]: C = 1
       Case "C3": T3 = [B3]: Set R = [B3]: C = 1
       Case "A1": T1 = [B1]: T2 = [B2]: T3 = [B3]: Set R = [B1:B3]: C = 1
    End Select
    If C = 0 Then Exit Sub
    Cancel = True
    If T1 & T2 & T3 = "" Then MsgBox "未輸入搜尋文字！ ", 0 + 16: Exit Sub
    Call 搜尋(Array(T1, T2, T3), Array(6, 7, 4))
    Union(.Cells, R).Interior.ColorIndex = 6
End With
End Sub

Qin

回復 34# 准提部林

准大的心法和招式真的千變萬化,層出不窮.

讓我想起很久以前, 在此論壇上的一位版主曾說過:
只有你想不到的, 沒有做不到的.

Qin

回復 28# Kubi

文接31樓
我想將原本的一個檔分成2個檔來使用.
A檔是: Data , Password 1234 , 路徑是 U:/ACWH/
B檔是: Search Data , Password 5678 , 路徑是 C:/Users/Public/Documents/
請問,要做這些修改, 語法又要如何寫呢?
2檔皆附上
在31樓

准提部林

回復 36# Qin


SearchData01.rar (48.77 KB)

下載次數: 5

2018-9-14 14:19

只能用2003版檔案格式, ".xls" 須改為 2007版以上的副檔名
〔檔案路徑〕自行去修改

Qin

回復 37# 准提部林

准大, 還有一些問題想修改, 勞煩了!
1) Data 檔資料持續增加中, 在有新資料更新才會打開更新 (有用密碼鎖上的 " 1234") , 所以希望在 使用 Search Data檔搜尋資料時,  Data 檔是不需要打開的
2) 希望搜尋結果所呈現的 "Date" 是由現今的年份至較久遠的年份...
3) 臨時想起, 想增加1個"日期"搜尋功能, 請参考 Search Data檔

Search Data1.rar (38.27 KB)

下載次數: 2

2018-9-16 01:05

准提部林

回復 38# Qin

1) Data 檔資料持續增加中, 在有新資料更新才會打開更新 (有用密碼鎖上的 " 1234") , 所以希望在 使用 Search Data檔搜尋資料時,  Data 檔是不需要打開的
　＿data是以〔唯讀〕開啟的，並不影響原檔自己的資料
2) 希望搜尋結果所呈現的 "Date" 是由現今的年份至較久遠的年份...
　＿什麼意思？？？
3) 臨時想起, 想增加1個"日期"搜尋功能, 請参考 Search Data檔
　＿如果日期都不輸入，如何篩？
　＿三條件不輸入，只有日期，如何篩？

Qin

回復 39# 准提部林

請參考

下載 (51.04 KB)

2018-9-16 16:52

下載 (124.81 KB)

2018-9-16 16:53

下載 (132.18 KB)

2018-9-16 16:53