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 質問
【63958】Re:Findについて かみちゃん 10/1/4(月) 5:38 発言
【63959】Re:Findについて kanabun 10/1/4(月) 10:22 発言
【64002】Re:Findについて きくと 10/1/9(土) 19:50 発言
【64005】Re:Findについて かみちゃん 10/1/9(土) 21:19 発言
【64006】Re:Findについて kanabun 10/1/9(土) 21:27 発言
【64007】Re:Findについて kanabun 10/1/9(土) 21:33 発言
【64008】Re:Findについて かみちゃん 10/1/9(土) 21:44 発言
【64010】Re:Findについて kanabun 10/1/9(土) 22:33 発言
【64011】Re:Findについて かみちゃん 10/1/9(土) 22:39 発言
【64013】Re:Findについて kanabun 10/1/9(土) 22:51 発言
【64015】Re:Findについて かみちゃん 10/1/9(土) 23:13 発言
【64012】Re:Findについて kanabun 10/1/9(土) 22:48 発言
【64029】Re:Findについて きくと 10/1/10(日) 20:07 お礼
【64030】Re:Findについて kanabun 10/1/10(日) 21:31 発言

18151 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free