Excel VBA質問箱 IV

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

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


13611 / 13644 ツリー ←次へ | 前へ→

【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 お礼

【4577】キーワード入力による検索
質問  林檎星  - 03/3/27(木) 14:07 -

引用なし
パスワード
   こんにちは。
表題のようなことがやりたいのですが、
どうしたらよいでしょうか?

1.基本的にはOR検索で
2.2つあるいは3つの文字を入力し、
3.その文字を赤に着色、
4.更にその文字を含む行がシート全体で何行あるかをカウント
5.別シートに4.の行をコピペする。

ということがしたいのですが…。
どなたか知っていたら教えてください。
おねがいします。

【4584】Re:キーワード入力による検索
発言  Jaka  - 03/3/27(木) 15:24 -

引用なし
パスワード
   こんにちは。

>1.基本的にはOR検索で
が、気になるんですけど、どのような意味なんでしょうか?
ループ組んで行ごとにFind、またはMatch関数で調べた方が簡単だと思いますが..。
もしかして、1個1個のセルを調べて行くってことなんでしょうか?
これだとメチャクチャ時間が掛かると思いますよ。

>2つあるいは3つの文字を入力し
どこに?

それと表示形式を変えているセルってありませんか?
単純に文字と数字だけなんでしょうか?

【4585】Re:キーワード入力による検索
発言  林檎星  - 03/3/27(木) 16:13 -

引用なし
パスワード
   レスありがとうございます。

>ループ組んで行ごとにFind、またはMatch関数で調べた方が簡単だと思いますが..。

最初countifを使いましたが、
列をまたぐとわからなくなってしまうのです・・・。


>>2つあるいは3つの文字を入力し
>どこに?

ダイアログで入力を考えていました。
表示形式は文字数字だけです。


▼Jaka さん:
>こんにちは。
>
>>1.基本的にはOR検索で
>が、気になるんですけど、どのような意味なんでしょうか?
>ループ組んで行ごとにFind、またはMatch関数で調べた方が簡単だと思いますが..。
>もしかして、1個1個のセルを調べて行くってことなんでしょうか?
>これだとメチャクチャ時間が掛かると思いますよ。
>
>>2つあるいは3つの文字を入力し
>どこに?
>
>それと表示形式を変えているセルってありませんか?
>単純に文字と数字だけなんでしょうか?

【4586】Re:キーワード入力による検索
回答  ポンタ  - 03/3/27(木) 17:19 -

引用なし
パスワード
   >ダイアログで入力を考えていました。
>表示形式は文字数字だけです。

は処理してませんが、こんな感じでどうでしょう?

標準モジュールに貼り付けて

  '検索したい文字列
  MyFindStr = Array("A", "B", "C")
  '検索するシート
  Set Ws1 = Worksheets("Sheet1")
  '貼り付けるシート
  Set Ws2 = Worksheets("Sheet2")

を書き換えてお試しください。


Sub test()
  Dim MyRange As Range, MyFind As Range
  Dim MyFindStr As Variant
  Dim i As Integer
  Dim Ws1 As Worksheet, Ws2 As Worksheet
  Dim FirstAddress As String
  '検索したい文字列
  MyFindStr = Array("A", "B", "C")
  '検索するシート
  Set Ws1 = Worksheets("Sheet1")
  '貼り付けるシート
  Set Ws2 = Worksheets("Sheet2")
  With Ws1.Cells
    For i = 0 To UBound(MyFindStr)
      Set MyFind = .Find(MyFindStr(i), , xlValue, xlWhole)
      If Not MyFind Is Nothing Then
        FirstAddress = MyFind.Address
        Do
          MyFind.Font.ColorIndex = 3
          If MyRange Is Nothing Then
            Set MyRange = MyFind
          Else
            Set MyRange = Union(MyRange, MyFind)
          End If
          Set MyFind = .FindNext(MyFind)
        Loop While Not MyFind Is Nothing And MyFind.Address <> FirstAddress
      End If
    Next
  End With
  For Each MyFind In MyRange.EntireRow.Areas
    Call MyFind.Copy(Ws2.Range("A65536").End(xlUp).Offset(1, 0))
  Next
End Sub

【4589】Re:キーワード入力による検索
発言  林檎星  - 03/3/27(木) 18:01 -

引用なし
パスワード
   わざわざありがとうございます。
やってもらっておいて悪いのですが

  For Each MyFind In MyRange.EntireRow.Areas

のところでエラーを起こしてしまいます。
もう少し、自分でもやってみますね。
それでは。

【4591】Re:キーワード入力による検索
回答  ポンタ  - 03/3/27(木) 20:10 -

引用なし
パスワード
     For Each MyFind In MyRange.EntireRow.Areas
    Call MyFind.Copy(Ws2.Range("A65536").End(xlUp).Offset(1, 0))
  Next



  For Each MyFind In Intersect(MyRange.EntireRow, Ws1.Columns(1))
    Call MyFind.EntireRow.Copy(Ws2.Range("A65536").End(xlUp).Offset(1, 0))
  Next

にするとどうですか?

【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

【4602】消し忘れ
回答  Jaka  - 03/3/28(金) 10:24 -

引用なし
パスワード
   >         Range(SaveAd).EntireRow.Select

上のところ消してね!

【4606】Re:キーワード入力による検索
質問  林檎星  - 03/3/28(金) 12:06 -

引用なし
パスワード
   Jaka さん はじめまして。
いくつか質問があるのですが、

まず、フォームの作成がよくわかりません。
TEXTボックスはシートに作るのですよね?
コマンドボタンは…?

(何も知らなくてすみません....)

また、
If Me.Controls("TextBox" & Ti).Value <> "" Then

の、Me がエラーを起こすようですが、なぜでしょうか?

【4607】Re:キーワード入力による検索
質問  林檎星  - 03/3/28(金) 12:20 -

引用なし
パスワード
   若干分かったのでもう一度、質問しなおします。

VBの画面で”ユーザーフォームの挿入”からフォームは引っ張れました。
ここから、テキストボックスを作ろうとするとエラーが起きてしまいます。
どうしてなのでしょう?

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

引用なし
パスワード
   えーと、
フォームを作ったときにツールボックスと言うのが出ませんでしたか?
もし出ていたなら、コントーロールタブ上の「ab|」ボタンがテキストボックスです。
ポインタを合わせると「テキストボックス」と出ると思います。

テキストボックスに作り方
「ab|」ボタンを押したらポインタをフォーム上に持っていてください。
ポインタが「+」に変わります。
後は、図形を書くのと同じような操作で作ったりサイズ変更、または異動や消す事も出来ます。

プロパティウインドウなどのことを話すと霧が無いので、
とにかくテクストボックスを3つ作ってください。

同じようにボタンを1個、いや2個作ってください。(1つは、終了ボタンとして...)
初めに作ったボタンが、CommandButton1になり実行ボタンになるようにコード書いてあります。

ボタンやテキストボックスを作り終えたら、フォームを右クリックして(ポインタが矢印状態)「コードの表示」を選んでください。
するとフォームエディタが開きますから、勝手に記入されたコードは消して、先に書いた私の貼りつけてください。

終了ボタンコードとして、下記を追加手貼りつけしてください。

Private Sub CommandButton2_Click()
  Unload Me
  End
End Sub


最後に標準モジュールに下記コードを貼りつけて、実行すればフォームが起動します。

Sub 実行()
  UserForm1.Show
End Sub

【4613】もうひとつ・・・
お礼  林檎星  - 03/3/28(金) 15:03 -

引用なし
パスワード
   Jaka さんありがとうございます!
教えてもらったとおりやったら、動作致しました。

あと、お願いがあるのですが、
入力した単語を“含む”セル(行)検索にするにはどうすればよいでしょうか?
今のものは、入力した単語と同一のセル検索ですよね?

FINDではなく、MATCHにするのでしょうか?
よろしくお願いいたします。

【4618】Re:もうひとつ・・・
回答  Jaka  - 03/3/28(金) 16:25 -

引用なし
パスワード
   ここの所を変えてください。

Set CCel = .Find(SachMj, After:=Range("IV" & i), _
      LookAt:=xlWhole, MatchCase:=True)

 ↓

Set CCel = .Find(SachMj, After:=Range("IV" & i), _
      LookIn:=xlValues)

【4619】ありがとうございました。
お礼  林檎星  - 03/3/28(金) 17:07 -

引用なし
パスワード
   Jakaさんいろいろありがとうございました。
ポンタさん、ありがとうございました。

これでだいぶ仕事が楽になります。
お世話様でした。
フォームについては、これから勉強していきます(汗)。
それでは。

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