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 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free