Excel VBA質問箱 IV

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

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


72785 / 76732 ←次へ | 前へ→

【8429】Re:初心者です。教えてください
回答  ichinose  - 03/10/16(木) 12:37 -

引用なし
パスワード
   ▼HM さん:
こんにちは。

>指定した値や文字があるセルの行を全て別のシートにコピーするマクロを作りたいのですが・・。どなたか教えてください。

以下のコードは"aaa"でアクティブシートを検索し、該当するセルを含む行を
左隣のシートにコピーするコード例です。試してみて下さい。
'=================================================================
Sub main()
  Dim f_value As Variant
  Dim find_cell As Range
  Dim copy_row As Range
  f_value = "aaa" '検索する値を入れる
  Set copy_row = Nothing
  Set find_cell = get_findcell(f_value, ActiveSheet.Cells)
  Do While Not find_cell Is Nothing
    If Not copy_row Is Nothing Then
     If Application.Intersect(copy_row, find_cell.EntireRow) Is Nothing Then
       Set copy_row = Union(copy_row, find_cell.EntireRow)
       End If
    Else
     Set copy_row = find_cell.EntireRow
     End If
    Set find_cell = get_findcell() '次の検索
    Loop
  If Not copy_row Is Nothing Then
    copy_row.Copy ActiveSheet.Next.Range("a1")
    End If
  Set copy_row = Nothing
End Sub
'========================================================================
Function get_findcell(Optional f_v As Variant = "", Optional rng As Range = Nothing, Optional 方法 As Long = 1) As Range
'指定された値でセル範囲を検索し、該当するセルを取得する
'input : f_v 検索する値
'    rng 検索する範囲
'    方法: :検索方法 1-完全一致 2-部分一致
'output:get_findcell 見つかったセル(見つからなかったときはNothingが返る)
  Static 検索範囲 As Range
  Static 最初に見つかったセル As Range
  Static 直前に見つかったセル As Range
  If Not rng Is Nothing Then
    Set 検索範囲 = rng
    End If
  If f_v <> "" Then
    Set get_findcell = 検索範囲.Find(f_v, , xlValue, 方法)
    If Not get_findcell Is Nothing Then
     Set 最初に見つかったセル = get_findcell
     Set 直前に見つかったセル = get_findcell
     End If
  Else
    Set get_findcell = 検索範囲.FindNext(直前に見つかったセル)
    If get_findcell.Address = 最初に見つかったセル.Address Then
     Set get_findcell = Nothing
    Else
     Set 直前に見つかったセル = get_findcell
     End If
    End If
End Function

0 hits

【8426】初心者です。教えてください HM 03/10/16(木) 11:08 質問
【8427】Re:初心者です。教えてください INA 03/10/16(木) 11:53 発言
【8428】Re:初心者です。教えてください INA 03/10/16(木) 11:56 回答
【8429】Re:初心者です。教えてください ichinose 03/10/16(木) 12:37 回答
【8430】Re:初心者です。教えてください NH 03/10/16(木) 13:27 回答

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