Excel VBA質問箱 IV

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

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


3658 / 13646 ツリー ←次へ | 前へ→

【60905】Find検索について mao 09/3/23(月) 9:24 質問[未読]
【60906】Re:Find検索について つん 09/3/23(月) 11:39 回答[未読]
【60907】Re:Find検索について Jaka 09/3/23(月) 13:21 発言[未読]
【60908】Re:Find検索について mao 09/3/23(月) 17:09 お礼[未読]

【60905】Find検索について
質問  mao  - 09/3/23(月) 9:24 -

引用なし
パスワード
   おはようございます。
質問させていただきます。

以下のシート(検索)があります。
 D列     E列    F列
会社コード  会社名   検索対象コード
12345     A会社   1111
56789     B会社   2222
01112     B会社   3333
 ・       ・    ・
 ・       ・    ・

1.ユーザーフォームで、TextBox1・コマンドボタン1を作成。
TextBox1に検索対象(F列)(重複のないデータです)の数字を入力、コマンドボタン1押下で検索を開始する。
2.見つかったらそのF列となりのE列(会社名)とD列(会社コード)
をメッセージボックスで表示。

やりたい事ですが、
検索後もしE列に同じ会社名が存在した場合(誤入力等を想定し)、
メッセージを出し同じ会社名のセルを赤色に塗りつぶす。
(検索対象FoundCellの隣E列FoundCell.offset(,-1)を検索するという事かと
思いますが、どの様にに代入するのかで行き詰ってしまいました・・・。)

アドバイス等いただければと思います。
どうぞよろしくお願いいたします。


Sub 検索()

Dim Mynumber As String
Dim FoundCell As Range
Dim fs, msg

Range("F1").Select
Mynumber = UserForm1.TextBox1.Text

Set FoundCell = Cells.Find(What:=Mynumber, After:=ActiveCell, _
              LookIn:=xlFormulas, LookAt:=xlPart, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlNext, MatchCase:=False, _
              MatchByte:=False)
              
 
With Worksheets("検索").UsedRange.Columns(6)

If Not FoundCell Is Nothing Then
    fs = FoundCell.Address

msg = MsgBox("会社コードは「" & FoundCell.Offset(, -2) & "」" & Chr(13) & _
    "会社名は「" & FoundCell.Offset(, -1) & " 」でした。", vbOKCancel)       

If msg = vbCancel Then
  Exit Sub

?※ここにF列検索後E列会社名=FoundCell.Offset(, -1)代入の式??

Do
  ?F列検索後E列会社名?.Interior.ColorIndex = 3
  Set ?F列検索後E列会社名? = .FindNext(?F列検索後E列会社名?)
Loop While Not ?F列検索後E列会社名? Is Nothing And ?F列検索後E列会社名?.Address <> FoundCell?検索最初の隣のE列?

End If
End With
End Sub


※↑?の部分が行き詰っている箇所です。

【60906】Re:Find検索について
回答  つん  - 09/3/23(月) 11:39 -

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


>Sub 検索()
>
>Dim Mynumber As String
>Dim FoundCell As Range
>Dim fs, msg
まず、「fs」はアドレスが格納されるので、String型
「msg」は、メッセージボックスの返り値なので、Long型で宣言されたらいいかと思います。


>Range("F1").Select
> Mynumber = UserForm1.TextBox1.Text
>
> Set FoundCell = Cells.Find(What:=Mynumber, After:=ActiveCell, _
>              LookIn:=xlFormulas, LookAt:=xlPart, _
>              SearchOrder:=xlByRows, _
>              SearchDirection:=xlNext, MatchCase:=False, _
>              MatchByte:=False)
「LookIn」は、今回は文字列を検索するで、「xlValues」じゃないかなあ・・・

 
> With Worksheets("検索").UsedRange.Columns(6)
>
> If Not FoundCell Is Nothing Then
>    fs = FoundCell.Address
     「コード」は繰り返して検索しないので、
      ここで、アドレスを取得しちゃだめです。
>
> msg = MsgBox("会社コードは「" & FoundCell.Offset(, -2) & "」" & Chr(13) & _
>    "会社名は「" & FoundCell.Offset(, -1) & " 」でした。", vbOKCancel)       
>
>If msg = vbCancel Then
>  Exit Sub
>
>?※ここにF列検索後E列会社名=FoundCell.Offset(, -1)代入の式??


  ここで、再び、先ほどヒットしたコードの会社名で新たに検索かけます。
  で、ヒットしたら、ここでアドレスを「fs」に入れて、
>Do
   ヒットしたセルに色づけ
   FindNextで続いて検索
Loop While Not FoundCell Is Nothing And FoundCell.Address <> fs
>
>End If
>End With
>End Sub
>
>
>※↑?の部分が行き詰っている箇所です。

こんな感じかなあ・・・・
「コード」を検索してから、次に「会社名」を検索する前に、「FoundCell」を初期化せんとあかんと思います。

途中で検索する列も変わるので、

> With Worksheets("検索").UsedRange.Columns(6)

これも検討し直した方がいいと思います。

雑な回答ですんませんが・・・・

【60907】Re:Find検索について
発言  Jaka  - 09/3/23(月) 13:21 -

引用なし
パスワード
   動かなかったので修正。
やりたい事が良く解ってないけど。

With Worksheets("検索")   '.UsedRange
 With .Columns(6)
  Set FoundCell = .Cells.Find(What:=Mynumber, After:=.Cells(.Cells.Count), _
              LookIn:=xlValues, LookAt:=xlPart, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlNext, MatchCase:=False, _
              MatchByte:=False)
 End With
 If FoundCell Is Nothing Then
   Exit Sub
 End If
 msg = MsgBox("会社コードは「" & FoundCell.Offset(, -2) & "」" & Chr(13) & _
    "会社名は「" & FoundCell.Offset(, -1) & " 」でした。", vbOKCancel)
 If msg = vbCancel Then
  Exit Sub
 End If

 fs = FoundCell.Row
 F列検索後E列会社名 = FoundCell.Offset(, -1).Value
 
 With .Columns(5)
  Set FoundCell = .Cells.Find(What:=F列検索後E列会社名, After:=.Cells(fs), _
              LookIn:=xlValues, LookAt:=xlPart, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlNext, MatchCase:=False, _
              MatchByte:=False)

  Do Until fs = FoundCell.Row
    FoundCell.Interior.ColorIndex = 3
    Ct = Ct + 1
    Set FoundCell = .FindNext(FoundCell)
  Loop
  If Ct > 0 Then
    .Cells(fs).Interior.ColorIndex = 3
  End If
 End With

End With

【60908】Re:Find検索について
お礼  mao  - 09/3/23(月) 17:09 -

引用なし
パスワード
   つんさん、Jakaさん、
アドバイスと修正をありがとうございました!
明日になってしまいますが、早速教えていただいた
コードを動かしてみたいと思います。。
取り急ぎお礼まで・・・

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