Excelのマクロで、特定のセルから順番に値を取得したい

Excelのマクロを作成しているのですが

1．指定したセル(例:A1)から特定の文字(例:結果)を含むセルの1つ上のセルまで上から順番に取得したい
(A10セルに『結果』という文字列があるなら1つ上のA9までを取りたい)

2．1でA1値を取得した時に同じ行の値(例:C1)を取得したい
(A2の時はC2、A5の時はC5といったイメージです)

3．1と2で取得した値をコレクション(例:collectionA)にaddしていきたい
stringA1 - stringC1
stringA2 - stringC2
・
・
・
みたいなイメージ？


以上3つの処理をVBAでどう書けば良いかで悩んでいます。

イメージとしては
A1の値を取得→同じ列のC1の値を取得
→A1とC1をcollectionAにadd
→これを『結果』という文字列があるA10の上のA9まで繰り返す
といった感じでしょうか


調べてみてもピンとくるものが見つからず…
どなたかどういう書き方をすれば良いか教えて頂きたいです！

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2022/12/06 17:06

こんばんは

collectionをですか、普通の配列だと使いにくいのかな・・
同じ値は無いと言う事で　一例サンプルです

範囲取得を行ってその範囲をループしてAddしていきます
使い方が分からないので一応
登録を配列にして　C列値（Key）を取得するケースを対応しました

Sub test0()
Dim myCollection As New Collection, i As Long, buf As String
Dim Rng As Range
Dim r As Range, rr As Range
Set r = Range("A1")
Set Rng = Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set rr = Rng.Find(What:="結果", LookIn:=xlValues, LookAt:=xlPart).Offset(-1)
Set r = Range(r, rr)
If Not rr Is Nothing Then
For i = 1 To r.Count
On Error Resume Next
myCollection.Add Array(r(i).Value, r(i).Offset(, 2).Value), r(i).Offset(, 2).Value
Next i
End If

'出力例
Dim coll As Variant
For Each coll In myCollection
buf = buf & coll(0) & "------" & coll(1) & vbCrLf
Next
MsgBox buf

End Sub


On Error Resume Nextは重複エラーの対応用なのでデバッグ時は外して確認してください（変数名は適当なので判り易く変えてください）

この回答へのお礼

お早い回答ありがとうございます！

VBA初心者のため検討はずれなことを言ってたら
申し訳ないのですが、

質問では例としてA1を始点にしていますが
これが例えば始点の場所がはっきりしていなくて
セル自体に名前が付けられているのでそれを元に指定する場合、
Set r = Range(セルの名前)
になるとは思いますが
この時、Set Range〜や、for文の1 to r.Countなど
他の部分の書き方も変わるのでしょうか？

お礼日時：2022/12/07 14:58

No.5 回答者： Qchan1962 回答日時： 2022/12/07 17:01

仕様と合うか分かりませんが遊び（検証用）の参考コード

Variant配列とDictionaryのコード

Sub sample()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dim r As Range, rr As Range, rng As Range
Set r = Range("AAA").Item(1)
Set rng = Range(r.Offset(1), Cells(Rows.Count, r.Column).End(xlUp))
Set rr = rng.Find(What:="結果", LookIn:=xlValues, LookAt:=xlPart).Offset(-1)
Set r = Range(r, rr)
If rr Is Nothing Then Exit Sub: MsgBox ""
Set r = Range(r, rr).Resize(, 3)
Dim arrData As Variant '配列
arrData = r.Value
Dim i As Long
Dim str As String
str = "Variant配列" & vbCrLf
For i = 1 To UBound(arrData, 1)
str = str & arrData(i, 1) & " : " & arrData(i, 3) & vbCrLf
Next i
MsgBox str
'配列から取り出し重複あるかも
For i = 1 To UBound(arrData, 1)
If Not Dic.Exists(arrData(i, 1)) Then
Dic.Add arrData(i, 1), arrData(i, 3)
End If
Next i
Dim v As Variant
'Dictionaryの要素参照例　vの重複無
str = "Dictionary" & vbCrLf
For Each v In Dic
str = str & v & " : " & Dic.Item(v) & vbCrLf
Next v
MsgBox str
End Sub

No.4 回答者： Qchan1962 回答日時： 2022/12/07 16:59

＞その下のadd周りは基本そのままって認識で良いのでしょうか？

Key取得以外は良いと思います
本当はcollectionでなく範囲（塊）が特定されるのであれば　
重複を省くならば連想配列を使用したり
ItemやKeyの取得設定が容易（パラメータがある）
重複を省かない場合は直接
Variant配列で取得すれば簡単かと・・・思います。
もっとも使う時（取得方法）によるかもですがね

この回答へのお礼

お陰様でだいぶ形になってきました！
色々質問攻めしてしまいましたが
丁寧に回答してくださり本当にありがとうございます！
(とりあえずbaは一番最初のにしてます)

お礼日時：2022/12/08 17:10

No.3 回答者： Qchan1962 回答日時： 2022/12/07 15:40

＞この時、Set Range〜や、for文の1 to r.Countなど

Set r = Range("A1")
これを　Set r = Range("AAA")　のようにした場合（名前AAA）
そのあとに出て来る定数も変更する必要があります

例えば
Set r = Range("AAA")
Set Rng = Range(r.Offset(1), Cells(Rows.Count, r.Column).End(xlUp))
Set rr = Rng.Find(What:="結果", LookIn:=xlValues, LookAt:=xlPart).Offset(-1)
Set r = Range(r, rr)
r.Select

名前AAAセルから同じ行の結果が入力されている上のセルまでが選択されます
注意としては名前の付いたセルは範囲の可能性もありますので
Itemインデックスで特定したりする必要があるかも知れません
Set r = Range("AAA").Item(1)
更に存在しない場合などのエラー対策も必須になると思います

＞r.Count
については最後に再設定したrのセルの個数なので1列のみであれば変える必要はないと思われます

この回答へのお礼

なるほど…！
指定のセルが範囲か、存在の有無は他の部分で事前にチェックする処理が入ってるので大丈夫だと思います！

for文の1 to r.Countは変える必要は無いんですね〜
その下のadd周りは基本そのままって認識で良いのでしょうか？

お礼日時：2022/12/07 16:13

No.2 回答者： Qchan1962 回答日時： 2022/12/06 19:35

すみません

Set r = Range(r, rr)
If Not rr Is Nothing Then
上下逆でしたね
あと見つからなかった場合のElse処理も入れた方が良かったかな

myCollection.Add Array(r(i).Value, r(i).Offset(, 2).Value), r(i).Offset(, 2).Value　ここが判り難いかも知れないので追記します

VBA　Collection　をオブジェクトブラウザーで見ると
Add Count Item Remove の４つがあります

Collectionオブジェクトに値を代入する（リストを作る）場合　
AddでItem を登録します　その時合わせて呼び出しKeyも登録できます
Collection.Add Item:= ,Key:=

Add(Item, [Key], [Before], [After])　　

作成されたCollection Itemはインデックス又はKeyで呼び出せます
=Collection(Key)　　　=Collection(番目)
worksheetsオブジェクトと似ています　KeyがNameみたいな・・です
しかし、例ではKeyを取得するプロパティが無いのでItemを配列にして
Keyと同じ値を付加して代用しています（使う事はないかもですが）

myCollection.Add Array(Item,Keyの代用), Key　
従って　Item(0) が　Item　Item(1)がKeyの代替え値になります
もっともご質問の場合、Keyは不要かも知れませんね