[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Application.Match』（諸子頑鉄）
例えば以下のコードの場合
検索範囲に検索値が複数合っても最初の行しか求められませんが全て求めるにはどうすれば良いですか？
つまり、３個ヒットすれば
２，１０，１５行と全て求めたい
check = Application.Match(ws1.Range("B6"), ws2.Columns("A"), 0)
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
find（Findnext)で配列にヒット行を以下で求められましたが
ほぼネットの知識の丸写しで無駄がありそうです。
もっと分かりやすいコードになりませんか ？
Sub findnext()
Dim rng As Range, fd As Range, searchRng As Range
Dim wsモデル As Worksheet
Dim ws一覧 As Worksheet
Dim m
Dim arr() As Long
Set wsモデル = Worksheets("モデル")
Set ws一覧 = Worksheets("一覧")
Set searchRng = ws一覧.Range("A:A")
' 最初はFindで検索
Set rng = searchRng.Find("a")
'見つからなかったら終了
If IsError(rng) Then
MsgBox "指定した値が見つかりませんでした。"
Exit Sub
End If
' 検索結果を一時保存
Set fd = rng
ReDim arr(1)
arr(1) = rng.Row
Do
' FindNextで検索を継続
Set rng = searchRng.findnext(rng)
'findnextは、指定範囲をすべて検索し終えたら最初に戻るので
' Addressで確認！
' これを忘れると無限ループになるので注意！
If rng.Address = fd.Address Then
Exit Do
Else
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = rng.Row
End If
Loop
Stop
End Sub
matchを使うとして検索範囲をヒットした次の行から最終行までとする
アイデアはすぐに思いついたのですがイマイチの手法に思えたので
別解を求めました。
findを模索中です。
（諸子頑鉄） 2023/02/11(土) 08:16:52
あと、Findメソッドは見つからなかった場合「Nothing」を返すので↓は、違和感があります。
If IsError(rng) Then
（もこな２） 2023/02/11(土) 08:43:38
>Set rng = searchRng.Find("a")
クソみたいな人のを真似たようなので、短いのがカッケー と思わない事。 （ダサッ） 2023/02/11(土) 08:48:03
>matchを使うとして検索範囲をヒットした次の行から最終行までとする >アイデアはすぐに思いついたのですがイマイチの手法に思えたので >別解を求めました。
Findメソッドも、Match関数も１回の検索で見つかるのは1つ。
複数を探すなら何度もループするのは同じ。
Match関数の方が紛れが少ないので扱いが用意かも。
複数の結果を得るなら、「抽出」の機能（オートフィルターとかフィルターオプションとか）を
使用するとよいかと思われますが。。。。
（まっつわん） 2023/02/11(土) 09:06:54
【参考】 http://officetanaka.net/excel/vba/tips/tips123.htm
↑を踏まえて、提示のコードを修正してみるとこんな感じになります。
興味があれば【ステップ実行】して研究してみてください。（該当セルを着色するようにしてみました）
Sub 研究用()
Stop 'ブレークポイントの代わり
Dim 発見セル As Range, 発見セル群 As Range, tmp As Range
Dim 最初のセル番地 As String
With Worksheets("一覧").Range("A:A")
Set 発見セル = .Find(What:="a", LookIn:=xlValues, LookAt:=xlWhole)
If Not 発見セル Is Nothing Then
Set 発見セル群 = 発見セル
最初のセル番地 = 発見セル.Address
Do
Set 発見セル = .FindNext(発見セル)
If 発見セル.Address = 最初のセル番地 Then
Exit Do
Else
Set 発見セル群 = Union(発見セル群, 発見セル)
End If
Loop
End If
End With
If 発見セル群 Is Nothing Then
MsgBox "該当セルなし"
Else
発見セル群.Interior.Color = vbRed
End If
End Sub
なお、Findメソッドの引数には省略すると前回値を承継するものがありますので、LookIn、LookAtあたりは指定することをお勧めします
【参考】 https://www.moug.net/tech/exvba/0150111.html
（もこな２） 2023/02/11(土) 09:43:39
最近は、強力なワークシート関数が増えましたからねぇ・・
Filter関数を主軸に、ワークシート関数を活用する案
Set r = ws2.Range("A1", ws2.Cells(Rows.Count, "A").End(xlUp))
With WorksheetFunction
check = .Filter(.Sequence(r.Rows.Count), ws2.Evaluate(r.Address & "=" & ws1.Name & "!B6"), "無し")
End With
結果は 2次配列になります。
（半平太） 2023/02/11(土) 09:45:21
動作確認してません。
も少しデバッグしてブラッシュアップが必要かも。。。。参考になれば。。。
Option Explicit
Sub findnext02()
Const csKey As String = "a"
Dim rngFind As Range
Dim rngHit As Range
Dim vResults() As Variant
Dim i As Long
Dim s As String
Set rngFind = Worksheets("一覧").UsedRange.Range("A:A")
ReDim vResults(1 To rngFind.Cells.Count)
Set rngHit = rngFind.Find(csKey)
If rngHit Is Nothing Then Exit Sub
s = rngHit.Address(False, False)
Do
i = i + 1
vResults(i) = rngHit.Row
Set rngHit = rngFind.findnext(rngHit)
Loop Until rngHit.Address(False, False) = s
'結果の書き出し
Worksheets("モデル").Range("B2").Resize(i).Value _
= WorksheetFunction.Transpose(vResults)
End Sub
Sub testMatch()
Const csKey As String = "a"
Dim rngFind As Range
Dim vResults() As Variant
Dim i As Variant
Dim s As String
Set rngFind = Worksheets("一覧").UsedRange.Range("A:A")
ReDim vResults(1 To rngFind.Cells.Count)
Do
i = i + 1
On Error GoTo WayOut
vResults(i) = rngFind(WorksheetFunction.Match(sKey, rngFind, 0)).Row
On Error GoTo 0
With rngFind
Set rngFind = Application.Range(Worksheets("一覧").Cells(vResults(i), 1), .Cells(.Cells.Count))
End With
Loop
WayOut:
i = i - 1
If i > 0 Then
Worksheets("モデル").Range("B2").Resize(i).Value _
= WorksheetFunction.Transpose(vResults)
End If
End Sub
（まっつわん） 2023/02/11(土) 09:58:33
EVALUATEは使わなくても、このケースではCOUNTIFが使えた。 ・・けど、WorksheetFunctionではなく、Applicationにしないとダメだった。
Set r = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp))
With WorksheetFunction
check = .Filter(.Sequence(r.Rows.Count), Application.CountIf(Ws1.Range("B6"), r), "無し")
End With
（半平太） 2023/02/11(土) 10:51:51
とても短時間で探究するだけの能力が無いのでぼちぼち試してみています。
もこな２さんのコードのUNIONは便利ですね。
unionはRangeを合体して一つのCABINETとして扱えるようにする
「union(セルの場所が入った変数,次に合体したいセルの場所)」の順番で書いて、
それを「Set」という命令を使って変数に順次追加すれば
合体したいセルの場所がどんどん変数「発見セル郡」に格納されて行く。
あー、すごく便利だと思いましたが、
調べても範囲コピーして指定セルに張り付けるぐらいしか私には利用価値が思いつかなかった。
以下のような使い方は出来ますが、
発見セル.Copy
Worksheets("DATA").Cells(i, "G").PasteSpecial (xlPasteAll)
以下のような使い方は出来ないようです。
発見セル.Resize(0,2).Copy
範囲を拡張することは出来ないのでしょうか？
（諸子頑鉄） 2023/02/11(土) 14:07:12
（abc） 2023/02/11(土) 15:11:16
発見セル.Resize(,2).CopyでOKでした。
offsetと混同して（，２）を（０，２）と書いてしまう。
abcさん、ありがとう。
（諸子頑鉄） 2023/02/11(土) 16:18:12
その後、もこな２さんのコードを改造しました。
Option Explicit
Option Base 1
Sub 研究用1()
Dim 発見セル As Range, 発見セル群 As Range
Dim 最初のセル番地 As String
Dim i As Long
i = 1
With Worksheets("DATA").Range("A:A")
Set 発見セル = .Find(WHAT:="hit", LookIn:=xlValues, LOOKAT:=xlWhole)
If 発見セル Is Nothing Then
MsgBox "該当セルがありません。"
Exit Sub
End If
Set 発見セル群 = 発見セル '----------- (1)
最初のセル番地 = 発見セル.Address
Worksheets("DATA").Cells(i, "F") = 最初のセル番地
発見セル.Resize(, 3).Copy
Worksheets("DATA").Cells(i, "G").PasteSpecial (xlPasteAll)
Do
i = i + 1
Set 発見セル = .FindNext(発見セル)
'一回りしたのでサーチの必要はなく成る
If 発見セル.Address = 最初のセル番地 Then
MsgBox "FindNextが終了しました。"
Exit Do
Else
Set 発見セル群 = Union(発見セル群, 発見セル)
Worksheets("DATA").Cells(i, "F") = 発見セル.Address
発見セル.Resize(, 3).Copy
Worksheets("DATA").Cells(i, "G").PasteSpecial (xlPasteAll)
End If
Loop
End With
End Sub
結果、
F,G列にFIND（FINDNEXT）の情報を以下のように抽出できました
|[F] |[G]|[H]|[I]
[1]|$A$4|hit| 4|b
[2]|$A$5|hit| 5|a
[3]|$A$8|hit| 8|b
せっかくUNIONを使っているで直接UNIONから情報が抽出できないかと考えました。
UNIONには、AREASがあるのでこれを利用できないかと
イメージとして
UNION(発見セル群)は、
UNION(Range("A4"),Range("A5"),Range("A8"))
１）そこで以下でK列に抽出処理を試みるもエラー発生。
２）しかも「ct」は３個と考えていたのにローカルウインドウを見ると２個と表示されているし
３）「発見セル群」の内部？をチェックしようとローカルウインドウの
式中の「＋発見セル郡」をクリックするも階層表示で膨大な項目があってどこを見たら良いか判りませんでした。
Dim ct As Long
Dim unit As Variant
ct = 発見セル群.Areas.Count
For i = 1 To ct
unit(i) = 発見セル群.Areas(i).adress
Worksheets("DATA").Cells(i, "K") = unit(i)
Next
１），２）、３）に付きアドバイスをお願いします。
（諸子頑鉄） 2023/02/12(日) 08:13:26
想像するに、条件（検索値に値が一致するセル）にあう【セル】をすべて探して
同じシートのF列4行目以降に、セル番地を順番に書きだす 同じシートのG列4行目以降に、コピペする（検索値を書き出すでもOK）
同じシートのH列4行目以降に、セル行番号を順番に書きだす 同じシートのI列4行目以降はよくわかりません。
ということかなとも思いましたが、↑であってますか？
（もこな２） 2023/02/12(日) 11:22:20
Sub 研究用2()
Stop 'ブレークポイントの代わり
Dim 発見セル As Range, 発見セル群 As Range, tmp As Range
Dim 最初のセル番地 As String
Dim i As Long
With Worksheets("DATA")
Set 発見セル = .Range("A:A").Find(WHAT:="hit", LookIn:=xlValues, LOOKAT:=xlWhole, After:=.Cells(.Rows.Count, "A"))
If Not 発見セル Is Nothing Then
Set 発見セル群 = 発見セル
最初のセル番地 = 発見セル.Address
Do
Set 発見セル = .Range("A:A").FindNext(発見セル)
If 発見セル.Address = 最初のセル番地 Then
Exit Do
Else
Set 発見セル群 = Union(発見セル群, 発見セル)
End If
Loop
End If
If 発見セル群 Is Nothing Then
MsgBox "該当セルなし"
Else
'コピペで済む処理
発見セル群.Copy .Range("G4")
'コピペで済まない処理
For Each tmp In 発見セル群
.Cells(i + 4, "F").Value = tmp.Address
.Cells(i + 4, "H").Value = tmp.Row
i = i + 1
Next
発見セル群.Copy .Range("G4")
End If
End With
End Sub
また、配列に拘った処理をしたいということならば、
Sub 研究用3()
Dim 二次元配列 As Variant
〜〜〜 中略 〜〜〜
If 発見セル群 Is Nothing Then
MsgBox "該当セルなし"
Else
ReDim 二次元配列(1 To 発見セル群.Cells.Count, 1 To 3)
For Each tmp In 発見セル群
i = i + 1
二次元配列(i, 1) = tmp.Address
二次元配列(i, 2) = tmp.Value
二次元配列(i, 3) = tmp.Row
Next
.Range("G4").Resize(発見セル群.Cells.Count, 3).Value = 二次元配列
End If
End With
End Sub
としてはどうでしょうか？
（もこな２） 2023/02/12(日) 11:59:47
発見セル.Resize(,2).Copy
仰る通り↑は（単一セルなので）OKですが、発見セル群は複数セルの可能性があり、それが飛び飛びのセルの場合↓は失敗します。
発見セル群.Resize(,2).Copy
そのような場合は、例えば↓のように【発見セル群を含む行全体】と【コピーしたい列】が交差するセルを求めるとよいと思います。
Intersect(発見セル群.EntireRow, Worksheets("DATA").Range("A:B")).Copy
（もこな２） 2023/02/12(日) 12:15:45
UPしたコードで
F列１行目以降に、セル番地を順番に書き出せています。
又、コードが
発見セル.Resize(, 3).Copyなので
G,H,I行に一括してコピペ
Cells(i, "G").PasteSpecial で
結果
G列１行目以降に、コピペできています
H列１行目以降に、コピペできています
I列１行目以降に、コピペ出来ています。
ここまでは出来たのでせっかくUNIONを知ったので
イメージとして
UNION(発見セル群)には、
UNION(Range("A4"),Range("A5"),Range("A8"))
の３つの各セル情報が入っているのでこれを利用して
別の方法でF,G,H,Iに抽出した情報を抽出できないかと考えたわけです。
それで考えたのが、以下のコードになりますが
１）コードは不完全でエラーで抽出できません
Dim ct As Long
Dim unit As Variant
ct = 発見セル群.Areas.Count
For i = 1 To ct
unit(i) = 発見セル群.Areas(i).adress
Worksheets("DATA").Cells(i, "K") = unit(i)
Next
エラーを考えていくうちに２），３）の疑問点が出来たわけです。
判るにくい相談ですいません。
（諸子頑鉄） 2023/02/12(日) 12:18:26
拙速回答ですが。
1)そこで以下でK列に抽出処理を試みるもエラー発生。
⇒エラー発生行とエラーメッセージが必要です。
unitというのはなんですか? 配列としての宣言がされていません。
2)しかも「ct」は3個と考えていたのにローカルウインドウを見ると2個と表示されているし
⇒Areaなので、4行目と5行目はエリアとしては一つにカウントされ、
都合二つですから、辻褄はあっています。
3)「発見セル群」の内部?をチェックしようとローカルウインドウの
式中の「+発見セル郡」をクリックするも階層表示で膨大な項目があってどこを見たら良いか判りません
⇒それはRangeオブジェクトです。
ローカルウインドウはすべてのプロパティを網羅するわけではありません。
Addressプロパティは表示されません。
イミディエイトウインドウで、
?発見セル群.Address
とするとよいでしょう。
（abc） 2023/02/12(日) 13:24:19
＞⇒エラー発生行とエラーメッセージが必要です。
Dim unit As Variant では
unit(i) = 発見セル群.Areas(i).adress で
「型が一致しません。」
＞unitというのはなんですか? 配列としての宣言がされていません
UNIONが塊（かたまり）の意味なら、
それを分割したいUnitは、単一(unit)にした変数名の意味。
配列としての宣言がされていません
Dim unit() As Variant では
エラー内容が以下に変わりました。
「インデックスが有効範囲にありません。」
＞Areaなので、4行目と5行目はエリアとしては一つにカウント
４，５のように連続する場合は一つとカウントされるのですね。
そのような仕様ならUNIONからunitに分割すると言う
私の想定は、根底からくつがえるので提案したコードも使えません。
UNIONからunitに分割する案は捨てるべきですか ？
＞ローカルウインドウはすべてのプロパティを網羅するわけではありません。
そうなんですね。
ローカルウインドウを見ればプロパティが全て表示されると思っていました。
＞イミディエイトウインドウで、
＞?発見セル群.Address とすると
?発見セル群.Address $A$4:$A$5,$A$8
と表示されました。
確かに２個ですね。
ローカルウィンドウには、何が表示されて、何が表示されないのか？
少し調べてみます。
（諸子頑鉄） 2023/02/12(日) 15:32:34
動的配列を使うには、Redimを使って大きさを指示する必要があります。 配列に関する記事を学習されることです。こうした質問掲示板で質問しても効率は悪いです。 よく読んでいませんが、出発点に戻られたほうが良い気がします。
ヒットした各セル範囲について、なんらかの作業をしたいのであれば、
(1)ヒットした都度、処理をしてしまうのが簡便です。
(2)いったん条件にあうセル範囲のコレクションをUnionを使って作り、
まとめて処理したいのであれば、
そのRangeに対して、For each r in そのRange
のようにして、各要素について、走査すればよいでしょう。
一般的な話として、コレクションの各要素を走査（各要素について順次処理）する場合、 ・まずは For Each ... Next を考えます。それができればそれが最上の方法です。 ・もし、作業のなかで何番目という情報(index情報）が必要なら、 For k= 1 to .... Next という形式を使います。 これが基本です。
------- | ローカルウィンドウには、何が表示されて、何が表示されないのか？ | 少し調べてみます。 調べられたらよいと思いますが、たぶんそうした差異に関するまとまった情報はないと思います。 ・もともとオブジェクトがどんなプロパティを持つかは、オブジェクトブラウザによるしかありません。 （プログラマブルにリストを得るような、いわゆるリフレクション機能はVB6には用意されていません） ・またローカルウインドウが何を出力するかについても、結果を知らされるだけです。 ・すべてのオブジェクトについて、その差異をつきつめるのは、労多くして益が少ないので、 そうしたことを行うインセンティブはありません。 ・ローカルウインドウにはそうした性質があることを念頭に、個々対応する というのが、現実的な対応です。
（abc） 2023/02/12(日) 16:25:24
（隠居Z） 2023/02/12(日) 16:40:21
補足情報です。
＞ローカルウインドウはすべてのプロパティを網羅するわけではありません。 たしかにAddressはプロパティですが、引数を持つものなので、かなりメソッド的ですよね。 一意的に結果が決まらない。何かを指定しないと決まらないものは表示はできないということでしょう。
このほか、最終行などを得るときに使う、Endもプロパティですが、 これも引数に依存して一意にはきまりません。
このように同じプロパティであっても、かなり性格の異なるものがあります。 メソッドなのか、プロパティなのか判断に迷うものもあります。 仕様のなかには、こうした「こう決めました」というものもかなりあるということです。 余談の追加でした。
（abc） 2023/02/12(日) 17:22:29
ReDim unit(ct) でエラー無く処理できました。
連続するセルがあるので２つに対して続いてさらなる処理をして行かなくては行けないので
思っていたようには簡単には行きそうにないです。
おっしゃるように最初に考えたコードのように
ヒットした都度、処理をしてしまうのが賢明で簡単なようです。
（まぎれも少なくなるので話が単純に成る）
$A$4:$A$5
$A$8
ローカルウインドウについて調べるのは、苦労が多いのに見返りが少なく
得策ではないとの事なので沼に入る前に追求するのをやめます。
＞一般的な話として、コレクションの各要素を走査（各要素について順次処理）する場合、
＞・まずは For Each ... Next を考えます。それができればそれが最上の方法です。
隠居ｚさんもFor Each の使用を提案されているのモノになるかどうかは判りませんが
少し考えてみます。
（諸子頑鉄） 2023/02/12(日) 18:24:47
Sub 研究用4()
Stop 'ブレークポイントの代わり
Dim 発見セル As Range, 発見セル群 As Range, tmp As Range
Dim 最初のセル番地 As String
Dim i As Long
With Worksheets("DATA")
Set 発見セル = .Range("A:A").Find(WHAT:="hit", LookIn:=xlValues, LOOKAT:=xlWhole, After:=.Cells(.Rows.Count, "A"))
If Not 発見セル Is Nothing Then
Set 発見セル群 = 発見セル
最初のセル番地 = 発見セル.Address
Do
Set 発見セル = .Range("A:A").FindNext(発見セル)
If 発見セル.Address = 最初のセル番地 Then
Exit Do
Else
Set 発見セル群 = Union(発見セル群, 発見セル)
End If
Loop
End If
If 発見セル群 Is Nothing Then
MsgBox "該当セルなし"
Else
For Each tmp In 発見セル群
.Cells(i + 4, "F").Resize(1, 3).Value = Array(tmp.Address, tmp.Value, tmp.Row)
i = i + 1
Next
End If
End With
End Sub
■２
いやいや、該当セルが【見つかるごとに】、【G4セル以降にセルの情報を行単位で出力】したいというのであればこんな感じでしょうか。
Sub 研究用5()
Stop 'ブレークポイントの代わり
Dim 発見セル As Range
Dim 最初のセル番地 As String
Dim i As Long
With Worksheets("DATA")
Set 発見セル = .Range("A:A").Find(WHAT:="hit", LookIn:=xlValues, LOOKAT:=xlWhole, After:=.Cells(.Rows.Count, "A"))
If Not 発見セル Is Nothing Then
.Cells(i + 4, "F").Resize(1, 3).Value = Array(発見セル.Address, 発見セル.Value, 発見セル.Row)
i = i + 1
最初のセル番地 = 発見セル.Address
Do
Set 発見セル = .Range("A:A").FindNext(発見セル)
If 発見セル.Address = 最初のセル番地 Then
Exit Do
Else
.Cells(i + 4, "F").Resize(1, 3).Value = Array(発見セル.Address, 発見セル.Value, 発見セル.Row)
i = i + 1
End If
Loop
End If
End With
End Sub
■３
そうでもなくて、【二次元配列】に一旦格納してから一気に出力したいということならば、先に示したように【セル】を【すべて見つけておいて】、該当セル数（＝行数）分の枠（配列）を用意してから順次格納していけばよいとおもいます。
このことについて、既にお気づきのようですが↓は勘違いをされていますよね。
＞UNION(発見セル群)には、
＞UNION(Range("A4"),Range("A5"),Range("A8"))
＞の３つの各セル情報が入っているのでこれを利用して
↓のようにしてみればわかるとおもいますが、格納されるセル数とそのAreas数は必ずしも一致しません。
Sub 確認用()
Dim tmp As Range
Dim i As Long
Set tmp = Union(Range("A4"), Range("A5"), Range("A8"))
For i = 1 To tmp.Areas.Count
MsgBox i & "つ目のAreasは" & vbLf & tmp.Areas(i).Address(0, 0)
Next
End Sub
よって、↓のように【セル】ごとに取り出したり、【行】ごとに取り出したりといった処理にしないと問題が出るように思います。
For Each tmp In 発見セル群
For Each tmp In Intersect(発見セル群.EntireRow, Worksheets("DATA").Range("A:B")).Rows
■４
踏まえて、繰り返しになりますが【どのようなデータ】を【どういう結果にしたいのか】、【ご自身の書いたコード】の【どういうところで困っているのか】を具体的に提示して相談いただくとアドバイスできることがあるかもしれません。
（もこな２） 2023/02/12(日) 19:13:13
1. > 連続するセルがあるので２つに対して続いてさらなる処理をして行かなくては行けないので > 思っていたようには簡単には行きそうにないです。 あなたがAreasを持ち出すのが、将棋で言えば「敗着」です。 Areaのコレクションにする必要などまったくなく、 Unionで得られたRangeオブジェクトについて、For Eachで各セルの処理をすればいいだけです。
2. > ローカルウインドウについて調べるのは、苦労が多いのに見返りが少なく得策ではない 誤解があるようです。 ローカルウインドウはデバッグをするうえでの重要なツールです。 これが分からないと、オブジェクトを使ったコードのデバッグはできないと言ってもいいくらいです。 私が申し上げたのは、「ローカルウインドウに表示されないプロパティを調べて列挙する」といったことが益がないだろう、という話です。 （abc） 2023/02/12(日) 19:19:28
これが適切であるとのMS社のコメントはありませんが、私的には大いに納得した内容でした。
一度読んでみるとよいとおもいますので提示しておきます。
（既に承知しているということならばお目汚し失礼しました。）
（もこな２） 2023/02/12(日) 19:26:17
Sub 確認用2()
Dim MyArea As Range, MyRNG As Range
Dim i As Long
For Each MyArea In Range("A1:A3,A5,A7:A10").Areas
For Each MyRNG In MyArea
i = i + 1
Debug.Print i & vbTab & vbTab & "MyArea:" & MyArea.Address(0, 0) & vbTab & vbTab & "MyRNG:" & MyRNG.Address(0, 0)
Next MyRNG
Debug.Print ""
Next MyArea
End Sub
例えば↑と↓で取り出される「MyRNG.Address」は同じものになります。
Sub 確認用3()
Dim MyRNG As Range
Dim i As Long
For Each MyRNG In Range("A1:A3,A5,A7:A10")
i = i + 1
Debug.Print i & vbTab & "MyRNG:" & MyRNG.Address(0, 0)
Next MyRNG
End Sub
（もこな２） 2023/02/12(日) 20:10:56
Sub 研究用2() 'unionを使った
Dim 発見セル As Range, 発見セル群 As Range
Dim 最初のセル番地 As String
Dim i As Long
i = 1
With Worksheets("DATA").Range("A:A")
Set 発見セル = .Find(WHAT:="hit", LookIn:=xlValues, LOOKAT:=xlWhole)
If 発見セル Is Nothing Then
MsgBox "該当セルがありません。"
Exit Sub
End If
Set 発見セル群 = 発見セル
最初のセル番地 = 発見セル.Address
Do
Set 発見セル = .FindNext(発見セル)
'一回りしたのでサーチの必要はなく成る
If 発見セル.Address = 最初のセル番地 Then
'MsgBox "FindNextが終了しました。"
Exit Do
Else
Set 発見セル群 = Union(発見セル群, 発見セル)
End If
Loop
Dim r As Variant
Dim rr As Variant
i = 1
For Each r In 発見セル群
rr = r.Address
Range(rr).Resize(, 3).Copy
Worksheets("DATA").Cells(i, "k").PasteSpecial (xlPasteAll)
i = i + 1
Next
End With
End Sub
もこな２さん、わかりにくい話に何度も長文の解答をいただきありがとうございます。
最初に以下のコードを想定してこれはこれで解決している案件です。
2023/02/12(日) 08:13:26
しかし、せっかくUnionを教えていただいたので勉強目的で
これを利用して同じような事が出来ないかと考えました。
皆様のおかげで上記コードで何とか同じことが出来ました。
VBA素人の私は、「こんな場合はこんなコード」を選択して最初に候補に挙げるなどが出来ません。
おなじ山に登るにもルートは複数あるのと同じで
もこな２さんが研究用の数種類のコードを書いていただいて
「こういう方法もあるよ」と教えていただけるはとても参考になります。
（挙げられるコードのどれが本筋（推薦）なのかが正直今は判りません。）
番外（ローカルウィンドウの件）も、ありがたいです。
abcさん、ローカルウインドウの件も含めてアドバイスありがとうございます。
「Areasを持ち出すのが、将棋で言えば「敗着」です。」
定番だと言われるFor Eachで処理できるので納得できます。
（諸子頑鉄） 2023/02/13(月) 07:48:06
＞「Areasを持ち出すのが、将棋で言えば「敗着」です。」 ＞定番だと言われるFor Eachで処理できるので納得できます。
何か違和感があるなぁ・・
Areasを使ったのは、ロジカルに処理しようとしたんじゃないんですか？ 何も悪手じゃないと思いますけど。
For Eachの仕様の詳細を知っている一般ユーザーは居ないでしょう。 経験で補っているだけ。
（半平太） 2023/02/13(月) 10:10:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.