VBA自动滚动到指定单元格
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row = 5 Then
'If Target.Value = 1 Then
' Application.Goto Reference:=Worksheets("Sheet1").Range("U154"), _
' scroll:=True
' Application.Wait Now + TimeValue("00:00:01")
' ActiveWindow.ScrollRow = 10
' ActiveWindow.ScrollColumn = 20
' End If
Select Case Target.Value
Case 1
FindValue ("1月")
Case 2
FindValue ("2月")
Case 3
FindValue ("3月")
Case 4
FindValue ("4月")
Case 5
FindValue ("5月")
Case 6
FindValue ("6月")
Case 7
FindValue ("7月")
Case 8
FindValue ("8月")
Case 9
FindValue ("9月")
Case 10
FindValue ("10月")
Case 11
FindValue ("11月")
Case 12
FindValue ("12月")
Case Else
FindValue ("1月")
End Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Sub FindValue(finstr As String)
Dim c As Range
Dim firstAddress As String
'With Worksheets("Sheet1").Range("H5:NI5")
With Range("H5:OE5")
Set c = .Find(finstr, LookIn:=xlValues, LookAt:=xlWhole, MatchByte:=True)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ActiveWindow.ScrollRow = c.Row
ActiveWindow.ScrollColumn = c.Column
Set c = .FindNext(c)
Exit Do
Loop While Not c Is Nothing
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row = 5 Then
'If Target.Value = 1 Then
' Application.Goto Reference:=Worksheets("Sheet1").Range("U154"), _
' scroll:=True
' ActiveWindow.ScrollRow = 10
' ActiveWindow.ScrollColumn = 20
' End If
Select Case Target.Value
Case 1
Application.Goto Reference:=Worksheets("Sheet1").Range("H5"), _
scroll:=True
Case 2
Application.Goto Reference:=Worksheets("Sheet1").Range("H5"), _
scroll:=True
Case 3
Application.Goto Reference:=Worksheets("Sheet1").Range("H5"), _
scroll:=True
Case 4
Application.Goto Reference:=Worksheets("Sheet1").Range("H5"), _
scroll:=True
Case 5
Application.Goto Reference:=Worksheets("Sheet1").Range("AL5"), _
scroll:=True
Case 6
Application.Goto Reference:=Worksheets("Sheet1").Range("BQ5"), _
scroll:=True
Case 7
Application.Goto Reference:=Worksheets("Sheet1").Range("CU5"), _
scroll:=True
Case 8
Application.Goto Reference:=Worksheets("Sheet1").Range("DZ5"), _
scroll:=True
Case 9
Application.Goto Reference:=Worksheets("Sheet1").Range("FE5"), _
scroll:=True
Case 10
Application.Goto Reference:=Worksheets("Sheet1").Range("GI5"), _
scroll:=True
Case 11
Application.Goto Reference:=Worksheets("Sheet1").Range("HN5"), _
scroll:=True
Case 12
Application.Goto Reference:=Worksheets("Sheet1").Range("IR5"), _
scroll:=True
Case Else
Application.Goto Reference:=Worksheets("Sheet1").Range("H5"), _
scroll:=True
End Select
Application.Wait Now + TimeValue("00:00:01")
End If
End Sub