- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-27
|
33#
發表於 2018-9-14 09:39
| 只看該作者
回復 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
|
|
發表於 2018-9-14 00:51
| 
