Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWindow.ScrollRow = 3
With Target
If .Address = "$B$1" Then
If .Value = "" Then [B4].AutoFilter Field:=2: Exit Sub 'Ｂ１空白，顯示全部不篩選
[B4].AutoFilter Field:=2, Criteria1:="*" & .Value & "*"
ElseIf Target.Address = "$B$2" Then
If .Value = "" Then [A4].AutoFilter Field:=1: Exit Sub
[A4].AutoFilter Field:=1, Criteria1:="*" & .Value & "*"
End If
End With
End Sub
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim j&, Jm&, xE As Range
With Target
If .Count > 1 Or .Column > 1 Or .Row < 5 Or .Item(1) = "" Then Exit Sub
For j = 3 To 13 '檢查輸入區有無資料
If j < 7 Or j > 8 Then If .Cells(1, j) <> "" Then Jm = 1: Exit For
Next j
If Jm = 0 Then MsgBox "本筆未輸入資料！": Exit Sub
Set xE = [資料查核區!A65536].End(xlUp)(2)
If xE.Row < 4 Then Set xE = [資料查核區!A4]
xE = [J1]
For j = 1 To 13 '帶入資料（含ＧＨ欄公式）
xE(1, j + 1) = .Cells(1, j).FormulaR1C1
Next j
Beep
End With
End Sub
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 清除篩選_Click()
Dim R&
With ActiveSheet
If .FilterMode Then .ShowAllData
R = .UsedRange.Rows.Count
[B1:B2,J2:K2].ClearContents
.Range("C5:F" & R).ClearContents
.Range("I5:M" & R).ClearContents
End With
End Sub作者: emma 時間: 2015-10-31 00:53
