| |
Changeイベントを下記に置き換え。
Private Sub Worksheet_Change(ByVal Target As Range)
Const wshInfoName As String = "結果"
Const CriteriaScope As String = "A1:D5"
Dim originalWord
Dim BufWord As String
If Target.Address(0, 0) <> "A2" Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
originalWord = Range("A1:H2").Value
BufWord = Target.Value
Application.Undo
myRedo = Target.Value
Target.Value = BufWord
Range("A1:D2,A3:T1506").ClearContents
Range("A1:B1").Value = Sheets(wshInfoName).Range("A1:B1").Value
Range("C1").Value = Sheets(wshInfoName).Range("D1").Value
Range("A2,B3,C4").Value = "*" & originalWord(2, 1) & "*"
Range("A2,B3,C4,D5").Value = "*" & originalWord(2, 1) & "*"
Sheets(wshInfoName).Columns("A:T").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("検索").Range(CriteriaScope), CopyToRange:=Range("A6"), Unique:=False
Range("A1:H2").Value = originalWord
Range("A3:D5").ClearContents
Columns("A:T").EntireColumn.AutoFit
ActiveWindow.FreezePanes = False
Rows("7:7").Select
ActiveWindow.FreezePanes = True
Application.GoTo Reference:="R6C1"
Rows("7:1500").RowHeight = 18.75
If Range("A7").Value <> "" And Range("A8").Value = "" Then
Call pickUpOneLine(Range("A7"))
End If
Range("A2").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
|
|
とおりすぎ
- 11/8/29(月) 10:02 -
