FINDで複数ヒットする場合

質問

EXCELで
範囲（A1:J2）で「東京」が存在する最初の列番号は以下で求められますが
範囲内には、他にも「東京」が複数ヒットします。
その場合は、どのようなコードになりますか　？

作業手順として考えたのは
最初に見つけた「東京」の次の列からを検索範囲に変更して次の「東京」をFIND
同じように検索範囲を次々と変更して最終的に「東京」が見つからなかったらFINDを終了すれば良さそうですが？

又、
他に良いコードがあれば教えてください。

Sub FindColumns()
Dim searchString As String
Dim searchRange As Range
Dim foundCell As Range
Dim columnNumbers As String

' 検索する文字列を指定
searchString = "東京"

' 検索範囲を指定
Set searchRange = Range("A1:J2")

' 検索を実行
Set foundCell = searchRange.Find(What:=searchString, LookIn:=xlValues, LookAt:=xlPart)

If foundCell Is Nothing Then
MsgBox "「東京」が見つかりませんでした。"
Else
MsgBox "ヒットした列番号: " & foundCell.Column
End If

End Sub

回答No.10

kkkkkm · ベストアンサー

質問のコードで試すのでしたら
A1とA3に東京と入れて
質問のコードで
after:=Range("J2")
を付けるか付けないかで実行して結果を見て、違いがあればFind.Nextとafterとは無関係ということになります。

回答No.6の補足のテストデータですが、同じデータを下にコピーしているので〇の位置が変化していません。
15行目の9/1が2行目の○がヒットした結果なのか5行目の○がヒットした結果なのか…。
after:=Range("J4")を外して違いが出なければいいですね。

回答No.16

kkkkkm

> 　私の利用している「エクセルの学校」で紹介されたVBAコードを記載します。

なるほど、便利なものがあったのですね。
クリップボード送りはなくてもいいかなと思ってたのですが、計算式までとかは思いつきませんでした。

回答No.15

kkkkkm

勝手に回答欄で遊んでいるコードの訂正です。

If IsDate(c.Value) = True Or IsNumeric(c.Value) = True Then
mLen = Len(c.Text)
Else
mLen = LenB(StrConv(c.Text, vbFromUnicode))
End If

のところは

mLen = LenB(StrConv(c.Text, vbFromUnicode))

に訂正です。

ふと時間が2023年9月2日みたいに半角全角が混ざっていたら駄目じゃないかと調べたら最初のままだとうまくいかず、訂正したほうがいい感じです。

お礼

kkkkkmさん、便利なコードを作成いただき感謝いたします。

以下について
　私の利用している「エクセルの学校」で紹介されたVBAコードを記載します。
　（「エクセルの学校」

>セル上でVBAで成型したものを手動でエディタにコピペするようにしたら楽そうと思って挑戦。

シートレイアウトの投稿どうしてますか？
https://www.excel.studio-kazu.jp/kw/20110209184943.html

レイアウトでは、計算式も書き出せるのでとても便利に利用させていただいてます。

後添付された画像を分かりやすくするために画面キャプチャーソフトを併用しています。

回答No.14

kkkkkm

必要かどうかもわからないのにやたら追加してすみません。

よく考えたら、余分なセルを変更しても必要な部分だけコピペすればいいのですからUsedRangeを使えばいいような気がしました。

何も入力されていないシートのB2からデータを貼り付けてあとは単に実行してください。
前回のように最後の列を選択とかはありませんし、A列の番号も入れなくていいです。
実行時にどこのセルを選択していてもいいです。

Sub TestUsedRange()
Dim c As Range
Dim i As Long
Dim MaxLen As Long, mLen As Long
Dim LastRow As Long, LastColumn As Long, mColumn As Long

LastRow = UsedRange.Rows(UsedRange.Rows.Count).Row
LastColumn = UsedRange.Columns(UsedRange.Columns.Count).Column

Cells(1, 1).Value = " "
For i = 2 To LastRow
Cells(i, 1).Value = "[" & i - 1 & "]"
Next

For mColumn = 1 To LastColumn
MaxLen = 0
If mColumn <> 1 Then
Cells(1, mColumn).Value = "[" & Chr(63 + mColumn) & "]"
End If
For Each c In Range(Cells(1, mColumn), Cells(LastRow, mColumn))
If IsDate(c.Value) = True Or IsNumeric(c.Value) = True Then
mLen = Len(c.Text)
Else
mLen = LenB(StrConv(c.Text, vbFromUnicode))
End If
If MaxLen < mLen Then
MaxLen = mLen
End If
Next
For Each c In Range(Cells(1, mColumn), Cells(LastRow, mColumn))
If IsDate(c.Value) = True Or IsNumeric(c.Value) = True Then
mLen = Len(c.Text)
Else
mLen = LenB(StrConv(c.Text, vbFromUnicode))
End If
If MaxLen > mLen Then
c.Value = c.Text & String(MaxLen - mLen, " ") & "|"
Else
c.Value = c.Text & "|"
End If
Next

Next

回答No.13

kkkkkm

勝手に作成した変更用VBAです。
変更後にコピペでエディタに貼り付けてください。TABが入ると思いますのでエディタで置換して削除してください。

A2に
="[" & ROW(A1) & "] |"
として10行目までコピー
A11に
="[" & ROW(A10) & "]|"
として適当な行数分コピー

して行数部分を作成しておいてください。
列の[A][B]などはVBAで記載しますので1行目は未入力で。

B2から元のデータを貼り付けてください。

データを変更したい列の右端のどこかのセルを選択してから実行してください。

2列目から選択しているセルの列までデータを変更します。

CurrentRegionとかUsedRangeで範囲決定しようかと思いましたが、A列が入ってしまいそうなので利用してません。

Sub Test()
Dim c As Range
Dim i As Long
Dim MaxLen As Long, mLen As Long
Dim LastRow As Long, mColumn As Long

For mColumn = 2 To Selection.Column
If LastRow < Cells(Rows.Count, mColumn).End(xlUp).Row Then
LastRow = Cells(Rows.Count, mColumn).End(xlUp).Row
End If
Next
For mColumn = 2 To Selection.Column
MaxLen = 0
Cells(1, mColumn).Value = "[" & Chr(63 + mColumn) & "]"

For Each c In Range(Cells(1, mColumn), Cells(LastRow, mColumn))
If IsDate(c.Value) = True Or IsNumeric(c.Value) = True Then
mLen = Len(c.Text)
Else
mLen = LenB(StrConv(c.Text, vbFromUnicode))
End If
If MaxLen < mLen Then
MaxLen = mLen
End If
Next
For Each c In Range(Cells(1, mColumn), Cells(LastRow, mColumn))
If IsDate(c.Value) = True Or IsNumeric(c.Value) = True Then
mLen = Len(c.Text)
Else
mLen = LenB(StrConv(c.Text, vbFromUnicode))
End If
If MaxLen > mLen Then
c.Value = c.Text & String(MaxLen - mLen, " ") & "|"
Else
c.Value = c.Text & "|"
End If
Next

Next

End Sub

回答No.12

kkkkkm

着地できたみたいで良かったです。
いつも質問やお礼などに記載してくれているデータですが、今回添付された画像を見るととても手がかかってそうでした。

セル上でVBAで成型したものを手動でエディタにコピペするようにしたら楽そうと思って挑戦。日付が無ければできたのですが、日付の文字数取得にちょっと難航中です。

もし、現在自動化していないのでしたら、しばしお待ちいただくとできるような気がします。

回答No.11

kkkkkm

試す場合念のためにafterなしからテストしてください。

お礼

何度もアドバイスありがとうございます。

以下のコードでafterがある場合と無い場合を試してみました。

結果は、kkkkkmさんの言うように
　afterがなければ指定範囲の最初の次("B2:J13"ならC2)から検索されていました。
　B2は最初にヒットせずに
　　最後に検索されるので一番最後に日付が表示されました。

範囲を確実に順番に検索したいなら
　検索範囲の最後のrangeをAfterで指定しないとダメなのがやっと理解できました。

　参照したネット情報が正しくないのが判りました。

結果の参考図
https://imgur.com/aeDhLE6

Sub FindColumns()
Dim SearchString As String
Dim SearchRange As Range
Dim FoundCell As Range
Dim FirstAddress As String
Dim i As Long, k As Long
Dim Cr1 As Long, Cr2 As Long

'書き出し箇所の初期化（クリアー）
Range("B15:K26").ClearComments

' 検索する文字列を指定
SearchString = "〇"

' 検索範囲を指定（例：A1からA10までの範囲）
Set SearchRange = Range("B2:J13")

Range("B1:J1").NumberFormatLocal = "m/d"
Range("B15:k26").NumberFormatLocal = "m/d"

' 検索を実行
'Set FoundCell = SearchRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows)
Set FoundCell = SearchRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows, after:=Range("J4"))

If FoundCell Is Nothing Then
MsgBox "〇が見つかりませんでした。"
Else
FirstAddress = FoundCell.Address
i = 15
k = 2
Do
Cr1 = FoundCell.Row
Cells(i, k) = Cells(1, FoundCell.Column).Value
Set FoundCell = SearchRange.FindNext(FoundCell)
Cr2 = FoundCell.Row
If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
Else
k = k + 1
End If

If Cr1 <> Cr2 Then
i = i + 1
k = 2
End If
Loop
End If

End Sub

回答No.9

kkkkkm

> Set SearchRange = Range("B2:J13")
最初は
> SearchRange = Range("B2:J4")
でしたので、こちらで考えてます。

お礼

>Set searchRange = Range("A1:J2")だとして

すいません。
例が適当でご迷惑をおかけしました。

この例は、一番最初(2023/08/28 08:52)です。

つづいていた今までの質問と違って
単独の質問としてに意味で範囲ならどこでも良いと適当に挙げてしました。
（OKWAVEで自分の質問で最初に表示されたSerchRangeをコピペして貼り付けました。）

>私はafterがなければ指定範囲の最初の次("B2:J13"ならC2)から検索されると考えてますので、基本的に違います。

なるほどやっと理解できました。

今回もスレが長くなり大変お世話になりました。
お礼申し上げます。

回答No.8

kkkkkm

> Set searchRange = Range("A1:J2")だとして

いつからその範囲になったのですか。
A1から範囲にしたらそりゃB2は最初にヒットします。

> Set SearchRange = Range("B2:J13")

コードでは上記でしたからコードと違います。

どちらにしても
afterがなくても指定範囲の最初("B2:J13"ならB2)から検索されているのでしたら私の意見は無視したほうがいいです。
私はafterがなければ指定範囲の最初の次("B2:J13"ならC2)から検索されると考えてますので、基本的に違います。

回答No.7

kkkkkm

> 参照先でMicrosoftが紹介されましたが、以下のような内容で
> 私が見た「エクセルの神髄」とほぼ同じ内容です。

肝心なところが違います。問題にしているところを説明したつもりですが、伝わらなければいいです。

どちらにしても以下の状態でしたら気にすることはないでしょう。

> 自前のコードとkkkkmさんのコードの両方で試してみましたが
> Afterが無くてもB2に○があった場合は、B7に9/1と表示されて
> B10が9/1となる表示にはなりませんでした。

そうですか、それでしたらAfterはなくていいですね。
ちなみに、私のコードは行を相対で指定してますから10行にはならずに9/1が本来の行の最後の列に追加されるだけです。

> iが9を超えるとどんな不具合がある

iは行指定だと思いますが、9行目までしか対象データが無いのにiが10になったらどうなるのでしょう。

お礼

>肝心なところが違います

すいません。
違いが理解できませんでした。

＞9行目までしか対象データが無いのにiが10になったらどうなるのでしょう。

If Cr1 <> Cr2 Then　で前回と行比較しているので
9行目までしかない対象データでiが10になる事は無いと思いますが？

’----------------------------------------------------
Set searchRange = Range("A1:J2")だとして

Set foundCell = searchRange.Find(What:=searchString, LookIn:=xlValues, LookAt:=xlPart,after:=range("J2"))
とafterを検索範囲の最後のセルと明示させた方が
Find.Nextで思わぬエラーが起こりにくいとアドバイスと理解しても良いのでしょうか？

回答No.6

kkkkkm

> B1に〇が有っても

B1じゃなくてB2の間違いでした。

> この引数を省略すると、対象セル範囲の左上端のセルが検索の開始点になります。

この悦明が間違っているか、「開始点」がAfterで指定した時のセル位置と同じと考えるのか…。

注意点1.には
> 引数、Afterの説明にもあるように、このセルの次のセルから検索が開始されるからです。
ここで「次から」とあり私の記憶と同じでしたので説明の所は見てませんでした。

Microsoftの説明です。

Range.Find メソッド (Excel)
https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.find

> この引数を指定しない場合は、範囲の左上端のセルの後から検索が開始されます。

とありますので、検索の開始はB2ではなくC2からになります。

あと、コードの気になる点ですが
i = i + 1
の時にiが9を超えたときにどうするのかを追加しておいた方がいいかもしれません。

補足

>この悦明が間違っているか、

記事の参照先は以下です。

エクセルの神髄 - 引数の説明(After)
https://excel-ubara.com/excelvba1/EXCELVBA398.html

確認の為、時々検索でお世話になっている「Office TANAKA」で「After」を見てみたら

[AFTER]
　　ここに指定したセルの次から検索を開始します。
　　省略するとexpressionの左上セルを指定したことになります

このexpressionがどういう意味なのかは？
理解できませんでした.

参照先でMicrosoftが紹介されましたが、以下のような内容で
私が見た「エクセルの神髄」とほぼ同じ内容です。

　　After　このセルの後から検索を開始します。
　　　これは、ユーザー インターフェイスから検索が実行されたときにアクティブなセルの場所に対応しています。

　　After は範囲内の 1 つのセルにする必要があることに注意してください。
　　このセルの後から検索が開始されるため、メソッドによって範囲内の他のセルがすべて検索され、
　　このセルに戻るまで、指定されたセルは検索されません。

　　この引数を指定しない場合は、範囲の左上端のセルの後から検索が開始されます。

'----------------------------------------------------------
＞B1じゃなくてB2の間違いでした。

修正して以下のようにになると思います。
Afterを最後のセル指定で入れておかないとB2に○があった場合9/1がB10に入ります。

実際に
自前のコードとkkkkmさんのコードの両方で試してみましたが
Afterが無くてもB2に○があった場合は、B7に9/1と表示されて
B10が9/1となる表示にはなりませんでした。

’----------------------------------------------------------------
＞あと、コードの気になる点ですが
＞ i = i + 1
＞の時にiが9を超えたときにどうするのかを追加しておいた方がいいかもしれません。

コードを修正してiが9を超える場合で試してみました。

iが9を超えても書き出し行に不具合が無かったのですが
iが9を超えるとどんな不具合があるのでコードを修正すべきなのでしょうか　？

|[A] |[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]
[1] | |9/1|9/2|9/3|9/4|9/5|9/6|9/7|9/8
[2] |蜷川 |〇 | | |〇 | | |〇 |
[3] |佐々木| |〇 |〇 | | | | |〇
[4] |田中 | | | |〇 |〇 |〇 | |
[5] |蜷川 |〇 | | |〇 | | |〇 |
[6] |佐々木| |〇 |〇 | | | | |〇
[7] |田中 | | | |〇 |〇 |〇 | |
[8] |蜷川 |〇 | | |〇 | | |〇 |
[9] |佐々木| |〇 |〇 | | | | |〇
[10]|田中 | | | |〇 |〇 |〇 | |
[11]|蜷川 |〇 | | |〇 | | |〇 |
[12]|佐々木| |〇 |〇 | | | | |〇
[13]|田中 | | | |〇 |〇 |〇 | |
[14]| | | | | | | | |
[15]|蜷川 |9/1|9/4|9/7| | | | |
[16]|佐々木|9/2|9/3|9/8| | | | |
[17]|田中 |9/4|9/5|9/6| | | | |
[18]|蜷川 |9/1|9/4|9/7| | | | |
[19]|佐々木|9/2|9/3|9/8| | | | |
[20]|田中 |9/4|9/5|9/6| | | | |
[21]|蜷川 |9/1|9/4|9/7| | | | |
[22]|佐々木|9/2|9/3|9/8| | | | |
[23]|田中 |9/4|9/5|9/6| | | | |
[24]|蜷川 |9/1|9/4|9/7| | | | |
[25]|佐々木|9/2|9/3|9/8| | | | |
[26]|田中 |9/4|9/5|9/6| | | | |

Sub FindColumns()
Dim SearchString As String
Dim SearchRange As Range
Dim FoundCell As Range
Dim FirstAddress As String
Dim i As Long, k As Long
Dim Cr1 As Long, Cr2 As Long

' 検索する文字列を指定
SearchString = "〇"

' 検索範囲を指定（例：A1からA10までの範囲）
Set SearchRange = Range("B2:J13")

Range("B1:J1").NumberFormatLocal = "m/d"
Range("B15:J26").NumberFormatLocal = "m/d"

' 検索を実行
Set FoundCell = SearchRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows, after:=Range("J4"))

If FoundCell Is Nothing Then
MsgBox "〇が見つかりませんでした。"
Else
FirstAddress = FoundCell.Address
i = 15
k = 2
Do
Cr1 = FoundCell.Row
Cells(i, k) = Cells(1, FoundCell.Column).Value
Set FoundCell = SearchRange.FindNext(FoundCell)
Cr2 = FoundCell.Row
If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
Else
k = k + 1
End If

If Cr1 <> Cr2 Then
i = i + 1
k = 2
End If
Loop
End If

End Sub