Excel VBA質問箱 IV

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

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


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

18151 / 76738

←次へ　｜　前へ→


	【64030】Re:Findについて

kanabun - 10/1/10(日) 21:31 -


	引用なし

	パスワード

▼きくとさん：

>ありがとうございます。行の選択が出来ました。
>これを別ブックにコピーするのが難航してますが頑張ります。

参考まで。

Sub Try1plus()
　Dim Rng As Range, r As Range
　Dim xCol As Long
　Dim Find1 As String
　Dim Find2 As String
　
　Find1 = "検索1"
　Find2 = "検索2"
　Set Rng = ActiveSheet.UsedRange 'シート全体
　xCol = Rng.Columns.Count
　With Rng.Columns(xCol + 1)
　　　.FormulaR1C1 = _
　　　　"=IF(AND(COUNTIF(RC1:RC[-1],""" & Find1 _
　　　　& """)>0,COUNTIF(RC1:RC[-1],""" & Find2 & """)>0),1,"""")"
　　　On Error Resume Next
　　　Set r = .SpecialCells(xlFormulas, xlNumbers)
　　　On Error GoTo 0
　　　If r Is Nothing Then
　　　　　MsgBox "検索に一致する行はありません"
　　　Else
　　　　　r.EntireRow.Select　　　　　　　'【該当行の選択】
　　　　　If MsgBox("これらの行がヒットしました" _
　　　　　　　　　　& "別ファイルに出力しますか？" _
　　　　　　　　　　, vbOKCancel) _
　　　　　　= vbOK Then
　　　　　'-----------------------------------------------
　　　　　　　Selection.Copy
　　　　　　　With Workbooks.Add(6).Worksheets(1)
　　　　　　　　　.Cells(1).PasteSpecial
　　　　　　　End With
　　　　　End If
　　　　　'-----------------------------------------------
　　　End If
　　　
　　　'後始末
　　　.ClearContents
　End With
End Sub

0 hits

▼

【63957】Findについて きくと 10/1/4(月) 0:17