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

質問

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

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.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)