Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

12551 / 76807

←次へ　｜　前へ→


	【69776】Re:検索前に戻したい

とおりすぎ - 11/8/29(月) 10:02 -


	引用なし

	パスワード

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

4 hits

▼

【69651】検索前に戻したい a 11/8/17(水) 8:06