投稿/コメントを表示します。

 小川先生、お世話になっております。VBA上級コースの最後にある総合問題の問題5をやっとできました。
連想配列を関数にした引数として渡すのにちょっと苦労。結構、試行錯誤はしましたが、動いた時には超気持ちよかったです。
 外部連携講座を一通り受講しました。
知識がないままでしたので、ほとんど頭の中には残っていませんが、クラスとインスタンスの事が連想配列のCreateObject(”Scripting.Dictionary”)の
表現から何となくですが、感覚的にちょっとこんなものかな~と感じています。
 余談でしたが、話を元に戻します。
 データを全て取り込む Fuctionプロシージャ <データ取込> と、区名を調べ、種類とその数を連想配列使った  Fuctionプロシージャ <区名_取得>
とSubプロシージャ <レポート_区> という感じで作りました。
 オブジェクト変数は受け渡す度に Set 構文が必要かなという印象を受けました。まだ全てを経験したわけではないので確かなことは言えませんが。?
プロシージャの名前はあえて漢字にしました。引数の受け渡しが感覚的に目で見えるようにとの考えで。
下記にソースコードを載せておきますので、ご感想なりをお聞かせ願えるとありがたいです。
 追伸、
先生にお聞きしたいのですが、私個人の感想では、外部連携講座の基礎コースはさすがに敷居が高いので、
イベントとフォーム講座を先に勉強したほうが良かったかなという印象でおりますが、その辺はどうでしょうか?

code 
Function データ取込() As Variant()
Dim lIst() As Variant
Dim cR As Long, cL As Long, RMax As Long, LMax
Dim rG As Range
RMax = Range("a" & Rows.Count).End(xlUp).Row - 2
LMax = Cells(2, Columns.Count).End(xlToLeft).Column - 1
ReDim lIst(LMax, RMax)
Set rG = Range("a2")
For cR = 0 To RMax
For cL = 0 To LMax
lIst(cL, cR) = rG.Offset(cR, cL).Value
Next
Next
データ取込 = lIst
End Function


Sub レポート_区()
Dim kUrenn As Scripting.Dictionary
Set kUrenn = CreateObject("Scripting.Dictionary")
Dim aLllt() As Variant, kEylt() As Variant, cKen As Long, rKst() As String
Dim c1 As Long, c2 As Long, cNt As Long, rCnt As Long, kSt As String, kEnc As Long
Const rGsl As String = "i"
Const rGsr As Long = 2
aLllt = データ取込()
Set kUrenn = 区名_取得()
kEylt = kUrenn.Keys
With Range(rGsl & rGsr)
For c1 = LBound(kEylt) To UBound(kEylt)
kSt = kEylt(c1)
cKen = kUrenn.Item(kSt)
.Offset(cNt, 0).Value = kSt & "のマンションは" & cKen & "件ありました。"
.Offset(cNt, 0).Font.Bold = True
For c2 = LBound(aLllt, 2) To UBound(aLllt, 2)
kEnc = 0
If Not kEnc = cKen Then
If kEylt(c1) = aLllt(2, c2) Then
rKst = Split(aLllt(6, c2), "/")
.Offset(cNt + 1, 1).Value = aLllt(5, c2)
.Offset(cNt + 1, 2).Value = aLllt(3, c2)
.Offset(cNt + 1, 3).Value = aLllt(4, c2)
.Offset(cNt + 1, 4).Value = rKst(0)
.Offset(cNt + 1, 5).Value = rKst(1)
cNt = cNt + 1
kEnc = kEnc + 1
End If
End If
Next
cNt = cNt + 2
Next
End With
End Sub


Function 区名_取得() As Scripting.Dictionary
Dim kUlist As Scripting.Dictionary
Set kUlist = CreateObject("Scripting.Dictionary")
Dim RMax As Long, rG As Range, kUmei As String, rCnt As Long
RMax = Range("c" & Rows.Count).End(xlUp).Row - 2
Set rG = Range("c2")
For rCnt = 0 To RMax
kUmei = rG.Offset(rCnt).Value
If kUlist.Exists(kUmei) Then
kUlist.Item(kUmei) = kUlist.Item(kUmei) + 1
Else
kUlist.Add (kUmei), 1
End If
Next
Set 区名_取得 = kUlist
End Function
/code
2015/10/06 01:53