Excel VBA質問箱 IV

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

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


76558 / 76738 ←次へ | 前へ→

【4601】Re:キーワード入力による検索
回答  Jaka  - 03/3/28(金) 10:19 -

引用なし
パスワード
   こんにちは。
入力ダイアログってのが良くわかんなかったんで、フォームを使ってみました。
フォームにTextBox1〜3まで3個とコマンドボタンを1つ作ってください。

尚、「2つあるいは3つの文字を入力し」ですが、同じ行に数種類の文字があった場合、ダブリチェックは入れていませんので、同じ行を何度か抽出してしまいます。
また、コピー先のシートのセルに赤く塗られたまま貼りつけています。色が不用でしたら後で色を消す必要もあります。

最後に
貼りつけ先の最終行をA列で判定していますので、コピー元シートのA列は空きが無い事が条件となっています。


Private Sub CommandButton1_Click()
  Dim UdAd As String, SRow As Long, ERow As Long, ECol As Integer
  Dim Fig As Boolean, CCel As Range, PastSheet As Worksheet
  Dim PWsEndR As Long
  
  UdAd = ActiveSheet.UsedRange.Address(0, 0)
  SRow = Range(UdAd).Row
  ERow = Range(UdAd).Cells(Range(UdAd).Count).Row
  Set PastSheet = Worksheets("Sheet2")
  SachCnt = 0
   
  For i = SRow To ERow
    With Range("A" & i & ":IV" & i)
      For Ti = 1 To 3
       Flg = False
       If Me.Controls("TextBox" & Ti).Value <> "" Then
         SachMj = Me.Controls("TextBox" & Ti).Value
         Set CCel = .Find(SachMj, After:=Range("IV" & i), _
              LookAt:=xlWhole, MatchCase:=True)
         If Not CCel Is Nothing Then
          SaveAd = CCel.Address
          Flg = True
          Do
            CCel.Interior.ColorIndex = 3
            Set CCel = .FindNext(CCel)
          Loop Until SaveAd = CCel.Address
         End If
       End If
       If Flg = True Then
         SachCnt = SachCnt + 1
         PWsEndR = PastSheet.Cells(Rows.Count, "A").End(xlUp).Row
         If SachCnt <> 1 Then
          PWsEndR = PWsEndR + 1
         End If
         Range(SaveAd).EntireRow.Select
         Range(SaveAd).EntireRow.Copy Destination:=PastSheet.Rows(PWsEndR)
       End If
      Next
    End With
  Next
  Set CCel = Nothing
  Set PastSheet = Nothing
  Unload Me
End Sub
5 hits

【4577】キーワード入力による検索 林檎星 03/3/27(木) 14:07 質問
【4584】Re:キーワード入力による検索 Jaka 03/3/27(木) 15:24 発言
【4585】Re:キーワード入力による検索 林檎星 03/3/27(木) 16:13 発言
【4586】Re:キーワード入力による検索 ポンタ 03/3/27(木) 17:19 回答
【4589】Re:キーワード入力による検索 林檎星 03/3/27(木) 18:01 発言
【4591】Re:キーワード入力による検索 ポンタ 03/3/27(木) 20:10 回答
【4601】Re:キーワード入力による検索 Jaka 03/3/28(金) 10:19 回答
【4602】消し忘れ Jaka 03/3/28(金) 10:24 回答
【4606】Re:キーワード入力による検索 林檎星 03/3/28(金) 12:06 質問
【4607】Re:キーワード入力による検索 林檎星 03/3/28(金) 12:20 質問
【4609】Re:キーワード入力による検索 Jaka 03/3/28(金) 13:08 回答
【4613】もうひとつ・・・ 林檎星 03/3/28(金) 15:03 お礼
【4618】Re:もうひとつ・・・ Jaka 03/3/28(金) 16:25 回答
【4619】ありがとうございました。 林檎星 03/3/28(金) 17:07 お礼

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