ＶＢＡ 繰り返し処理について

質問

ＶＢＡ初心者で書籍などで基本的な繰り返し処理のサンプル文を読んだのですが、
自分がやりたいことをどう繰り返し文で実現すればいいのかよくわかっていません。
やりたいことは以下なのですが、繰り返し文についてご教授ください。

Excel　ファイルイメージ
Ａ列　Ｂ列　Ｃ列
1 　　 11 　　 A
1 　　 12 　　 B
1 　　 13 　　 A
2 　　 21 　　 C
2 　　 22 　　 B
2 　　 23 　　 B
・・・
→このファイルイメージを参考にご説明すると、Ａ列で同じ値分
ループを回し、Ｃ列の値によって一つの値に絞り込むことを実行
したいです。

例えば、
A列が１で、C列にA，B，Aが存在した場合、Ａが二つあるので
B列の値が最大の行（例：13）のD列にＡという値を設定する。

回答No.7

argument · ベストアンサー

こんばんわ　Rosicky29　さん
>＜C列の判定パターン＞
>A,B,Cのすべてのパターンあった場合A
>A,Bのすべてのパターンあった場合A
>A,Cのすべてのパターンあった場合A
>B,Cのパターンの場合はB
>Aの場合のみはA
>Bの場合のみはB
>Cの場合のみはC
でしたね。そんな補足がありました。では回答しますが注意して頂きたいのは以下のサンプルは忠実に今いった条件です。
そう、文字が一文字でA～Zのうち最大が同じものがあった(C列の値を選定した時最大値のものが二つ以上あるときの処理です）場合。
たとえば
A　B　C　列
1　1　A
1　2　A
1　3　B
1　3　B
この場合C列の値ではAもBも2つあり(どちらも最大数)で前回の処理では選定されますよね。
まぁB列条件は今回も無視あくまで、前回条件に
アルファベット順で先にあるものを優先するという処理です。
残念ながらC列にどのような実際的な値が入るか教えて頂けなかったので例えばの処理です。
これは一文字かつアルファベットなら問題なく処理されます。

Sub test2()
catkey = vbCrLf: temp = ""
For i = 2 To Range("A65536").End(xlUp).Row + 1
If Range("A" & i - 1).Value = Range("A" & i).Value Then
temp = temp & Range("c" & i - 1).Value & catkey
Else
temp = temp & Range("c" & i - 1).Value
If InStr(temp, catkey) < 1 Then
Range("c" & i - 1).Interior.ColorIndex = 3
Else
temparray = Split(temp, catkey)
ReDim tempcount(UBound(temparray))
For j = 0 To UBound(temparray)
tempcount(j) = 0
For k = 0 To UBound(temparray)
If temparray(j) = temparray(k) Then tempcount(j) = tempcount(j) + 1
Next
Next
maxcount = 0
For j = 0 To UBound(tempcount)
If maxcount < tempcount(j) Then maxcount = tempcount(j)
Next
minchr = 99999
For j = 0 To UBound(tempcount)
If tempcount(j) = maxcount Then If minchr > Asc(temparray(j)) Then minchr = Asc(temparray(j))
Next
For j = 0 To UBound(tempcount)
If Asc(temparray(j)) = minchr Then Range("c" & i - 1 - (UBound(tempcount) - j)).Interior.ColorIndex = 3
Next
End If
temp = ""
End If
Next
End Sub

さて、実行してみたでしょうか？
C列の選定はアルファベット順で優先されたはずです(AとBならばAを優先するBとCならBを優先するCとZならCを優先するといった感じですね)。
ではどのように処理したか簡単に説明します。
例ではＣ列に入るデータはA～Zまたは全角Ａ～Ｚとしか読み取れない内容でした、もしかしたら私が情報を読み逃したのかもしれません(きっと後者でしょう)。
さておき、Ａ～Ｚで優先順位をつける場合どう判定するのかが今回の問題となります。
Ａ～Ｚ分の配列を作りましょうか？面倒ですね。
ではＡがＺに向かっていくアルファベットより優先されるものとは何でしょう？ここで直ぐに「文字コード」と浮かんだなら今回の件は直ぐですね。
全角Ａの文字コードは-32160で、Ｂは-32159・・・Ｚは-32135まで
半角ならばAなら65、Bなら66・・・Zなら90という順です。
全角にしろ半角にしろA～ZならばAの方が値が小さい。Zに向かっていくほど値が大きくなる。というわけです。
一文字なら全て問題なく処理できるでしょう。ですがあくまでコード順の優先順位です(まぁそれでも今回の補足分の回答は解決できるわけです）。

前回の処理に追加した処理はC列の最大数ある値を求めた後さらに文字コードがより小さいものを判定する処理を追加しただけです(4行追加＋1行の変更)。

ためしに3番さんの処理(C列の最大が二つ以上ある場合)も試してみたんですが、C列値にもっとも値が多いもので(最大のが二つ以上合った場合)C列に入っている順の最初のものの中から一番最後の行っていう判定なんですね。まぁCの最大二つ以上あるなんて想定外処理だったんでしょうが・・。

まぁ何はともあれ補足も解決したでしょう。
実際にC列に配列値が一文字ではなく文字列だったり他の条件だったりするとやっぱり配列を作って優先する値を判定するする処理が必要ですね。

処理違い・補足・追加処理等必要でしたらいってください。

お礼

>argumentさん
毎回、ご丁寧な説明でのご回答ありがとうございました。
最終的に実現したいことを達成できました。

自力でやっていたのですが、達成できず。。

今後ともよろしくお願いいたします。

回答No.6

pkh4989

No3 です。

データが1行からあるとして作成されたマクロですので、
もし、２行以降からデータが定義された場合は(１行は見出し?)、
同様なエラーになりますので、１行からデータを定義(見出し行を削除)
してから、試してみてください。

お礼

＞pkh4989さん
ご回答ありがとうございました。
当初の質問内容に記述しておりましたD列に値を設定する内容で、確認できました。

VBAの初歩的なところがまだわかっておらず、お手数をおかけしました。

回答No.5

argument

はじめまして　Rosicky29　さん
いや少し眠くなってきました。思いのほか苦戦しました。
それが果たして文章の解読かそれともソースの作成かは貴方のご想像にお任せします(もちろん後者です安心してください)。
今回の件はころころ内容が変わっているようですが定義を整理します。
条件1：A列の最終行までforをまわす
条件2：A列の同データ続く最後毎にC列の最も多いものを断定する
となります。

Sub test()
catkey = vbCrLf: temp = ""
For i = 2 To Range("A65536").End(xlUp).Row + 1
If Range("A" & i - 1).Value = Range("A" & i).Value Then
temp = temp & Range("c" & i - 1).Value & catkey
Else
temp = temp & Range("c" & i - 1).Value
If InStr(temp, catkey) < 1 Then
Range("c" & i - 1).Interior.ColorIndex = 3
Else
temparray = Split(temp, catkey)
ReDim tempcount(UBound(temparray))
For j = 0 To UBound(temparray)
tempcount(j) = 0
For k = 0 To UBound(temparray)
If temparray(j) = temparray(k) Then tempcount(j) = tempcount(j) + 1
Next
Next
maxcount = 0
For j = 0 To UBound(tempcount)
If maxcount < tempcount(j) Then maxcount = tempcount(j)
Next
For j = 0 To UBound(tempcount)
If tempcount(j) = maxcount Then Range("c" & i - 1 - (UBound(tempcount) - j)).Interior.ColorIndex = 3
Next
End If
temp = ""
End If
Next
End Sub

さて、実行させてみましたか？最後に提示された条件を満たしているはずです。
一応判定順を説明しましょう。
まず一番外枠のforはA列にデータのある限りまわります

この外郭が回る最中前行と一致している間tempにデータを特定文字で区切り格納し続けます。
もし、不一致が発生した場合tempに最後の前行を結合(C列解析範囲確定)
さらにその範囲を配列にし、C列のデータを自身にカウントさせます。
次にカウント結果のうちもっと多いものと特定します。
さらにその最大カウント数と一致するカウント列を列挙(着色)します
最後にC列の解析が終わったのでtemp内容をリセットします

これがA列の最後まで繰り返されます。

さて、ここまでくれば幾人かは質問者の最初の意図に気づいて上げられたのではないでしょうか？
この処理ではたとえばA列に同じものが続いたデータが一区切りとなりC列に最も多く含まれるものを列挙します。最初に提示されたデータなら1が最初三つ続くため解析対象は三行でA、B、AとなりAが一番多いため一行目Aと三行目Aに色がつきます。
ですがこれでは断定に至ったと言い難い。

ここでB列が生きてきます。このもっともC列に多いデータのうちさらにB列に入っている値が一番大きい行を特定したかった。
と言う事でしょう。この場合一行目と三行目と特定できるのですからあとはB列を比較しすればよいのです。
一行目は11　三行目は13　もちろん13の方が値が大きいため
三行目のAが本来確定する値なのでしょう。そしてその特定しきった値をD列に入れたかった・・・。

のだと思います。もちろん私の語学力は決して高いとは言えないでしょう。ですからあくまでも最後に提示されていた内容の処理となっています。まぁ仮に私が読みといた事があっていたとしてもここまでくればB列の比較処理を作るだけなのできっと　Rosicky29　さんにも作れるかと思います。

処理違い・補足・追加処理等必要でしたらいってください。

お礼

>argumentさん
はじめまして。この度は、解読が難しい質問内容（日本語）にしてしまいまして申し訳ございませんでした。
（質問内容の再定義までしていただきすいません）

＞他の皆様もすいませんでした。

処理を実行しましたところ、こちらの意図していることが
実現できました。ありがとうございました。

ちなみに、最終的には、再定義していただいた条件２の内容から
C列への分岐条件を変更した処理（下記、C列判定パターン）を実現
したいと思ってます。
（私のほうでもちょっと考えてみようと思います。）

＜C列の判定パターン＞
A,B,Cのすべてのパターンあった場合A
A,Bのすべてのパターンあった場合A
A,Cのすべてのパターンあった場合A
B,Cのパターンの場合はB
Aの場合のみはA
Bの場合のみはB
Cの場合のみはC

回答No.4

nekotaru

>Ａ列で同じ値分ループを回し
A列の最初の値は１ですが、どの行にたいしてループをまわすのでしょうか？
回す、の動きもわかりません。C列を上から下まで検索して１回でしょうか？
C列の１行目まで見るのがループを回す、の意味でしょうか？

補足

わかりにくい説明ですいませんでした。

補足説明させていただきます。
私の中での処理イメージ（(1)～(3)）は以下のように考えておりました。

(1)　A列で行に値がなくなるまでループを回します。
(2)　(1)でのループ処理に加えて、A列に設定されている同じ値内でネストしてループを回します。
(3)　(2)でのループ処理内で、C列に設定されている値をそれぞれ取得
し、その値の中で、一番多い値を特定し色づけなどを行う。

（ANo.1さんの補足でも説明させていただきましたが、本文の”例えば”に記述してあるB列に対する記述は無視していただいて結構です。）

回答No.3

pkh4989

'不具合があるかも知れませんが、試してみてください。
'
Sub 繰返し()
　　Dim mR　　　　　As Long
　　Dim sI　　　　　As Long
　　Dim eI　　　　　As Long
　　Dim wY　　　　　As Long
　　Dim wKey　　　　As String
　　Dim wStr　　　　As String
　　Dim wVal　　　　As Variant
　　Dim wRow　　　　As Long
　　'
　　With ActiveSheet
　　　　mR = Range("A" & Rows.Count).End(xlUp).Row
　　　　wKey = .Cells(1.1)
　　　　'
　　　　ExitFlg = False
　　　　sI = 1
　　　　Do While ExitFlg = False
　　　　　　'MAX行を求める
　　　　　　eI = Get_EndRow(wKey, sI, mR)
　　　　　　'KEY単位別にワークへ設定
　　　　　　wVal = .Range("A" & sI & ":D" & eI)
　　　　　　'EXCEL行を設定
　　　　　　For wY = 1 To eI - sI + 1
　　　　　　　　wVal(wY, 4) = sI + wY - 1
　　　　　　Next
　　　　　　'
　　　　　　'最大数の文字及び行を求める
　　　　　　Call Get_String(wVal, wStr, wRow)
　　　　　　.Cells(wRow, "D") = wStr
　　　　　　If eI >= mR Then
　　　　　　　　'終了
　　　　　　　　ExitFlg = True
　　　　　　Else
　　　　　　　　'次の開始行及びKEYを設定
　　　　　　　　sI = eI + 1
　　　　　　　　wKey = .Cells(sI, 1)
　　　　　　End If
　　　　Loop
　　End With
End Sub
'MAX行を求める
Function Get_EndRow(wStr As String, eI As Long, mR As Long) As Long
　　Dim wIx　　　　 As Long
　　'
　　Get_EndRow = mR
　　With ActiveSheet
　　　　For wIx = eI To mR
　　　　　　If CStr(Val(.Cells(wIx, 1))) <> wStr Then
　　　　　　　　Get_EndRow = wIx - 1
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End With
End Function
'最大数の文字及び行を求める
Function Get_String(wVal As Variant, wStr As String, wRow As Long) As String
　　Dim wI　　　　　As Integer
　　Dim wY　　　　　As Integer
　　Dim tBuf()　　　As String
　　Dim tCnt()　　　As Integer
　　Dim wSeq　　　　As Integer
　　Dim fFlg　　　　As Boolean
　　Dim mCnt　　　　As Integer
　　Dim mStr　　　　As String
　　'
　　wSeq = 0
　　For wI = 1 To UBound(wVal)
　　　　wStr = wVal(wI, 3)
　　　　If wSeq > 0 Then
　　　　　　fFlg = False
　　　　　　For wY = 1 To wSeq
　　　　　　　　If tBuf(wY) = wStr Then
　　　　　　　　　　tCnt(wY) = tCnt(wY) + 1
　　　　　　　　　　fFlg = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　If fFlg = False Then
　　　　　　　　wSeq = wSeq + 1
　　　　　　　　ReDim Preserve tBuf(wSeq)
　　　　　　　　ReDim Preserve tCnt(wSeq)
　　　　　　　　tBuf(wSeq) = wStr
　　　　　　　　tCnt(wSeq) = 1
　　　　　　End If
　　　　Else
　　　　　　wSeq = wSeq + 1
　　　　　　ReDim Preserve tBuf(wSeq)
　　　　　　ReDim Preserve tCnt(wSeq)
　　　　　　tBuf(wSeq) = wStr
　　　　　　tCnt(wSeq) = 1
　　　　End If
　　Next
　　'
　　'最大数の文字を設定
　　mCnt = 0
　　mStr = ""
　　For wI = 1 To wSeq
　　　　If mCnt < tCnt(wI) Then
　　　　　　mCnt = tCnt(wI)
　　　　　　mStr = tBuf(wI)
　　　　End If
　　Next
　　'行を求める
　　For wI = UBound(wVal) To 1 Step -1
　　　　If wVal(wI, 3) = mStr Then
　　　　　　wRow = wVal(wI, 4)
　　　　　　Exit For
　　　　End If
　　Next
　　'
　　wStr = mStr
End Function

お礼

ご回答ありがとうございました。
試しに実行してみたのですが、以下のようなエラーが発生しました。
対処方法などございましたら、ご教授ください。

＜エラーメッセージ＞
実行時エラー”1004”：
アプリケーション定義またはオブジェクト定義のエラーです。

＜エラー行＞
'KEY単位別にワークへ設定
wVal = .Range("A" & sI & ":D" & eI)

回答No.2

n-jun

ANo.1です。

質問の内容自体は何となくわかりました。
ただ私の力量では、かなりごちゃごちゃなコードになりそうで、スッキリといきません。
他の方の回答をお待ち下さい。

お礼

わかりにくい説明に読み解いてありがとうございました。

回答No.1

n-jun

>A列が１で、C列にA，B，Aが存在した場合、Ａが二つあるので
>B列の値が最大の行（例：13）のD列にＡという値を設定する。
この場合だとＣ列の値に関係なく、Ａ列が同じ行のＢ列の値から最大値を求めて、その行のＣ列の値をＤ列に返す。
と読み取れるのですが。。。？

補足

わかりにくい説明ですいませんでした。

Ｂ列は考慮に入れるとわかりにくいかもしれませんので、Ｂ列は考慮からはずすことにさせていただきます。

補足＋追記させていただきますと、
Ａ列で同じ値分ループを回し、Ｃ列の値で数の多い値を特定して、その値に対して、色づけする。Ａ列の同じ値分のループが終わったら、Ａ列次の値に対して、再度、同じ値分ループ＋Ｃ列の判定を実行する。
ということを実現したいです。