| |
▼初心者Ｍ さん：
>手元の表は...縦にはセルe8からe16まで、7個空けてe24からe32まで、とこれが下に25回並んでおり、横方向にはe8から2個空けてh8からh16まで、また2個空けてk8からk16までという具合に、こちらは27回並んでいます。
う〜ん、それだけたくさんのエリアだと、配列化はしにくいですね。
ちょっと時間はかかるけど、セルに直接アクセスしましょう。
最初のセルが[E8]で、[D8]に数値（部数）が書いてあると仮定します。
> '縦２５回
> '横２７回
ですから、縦方向へは 16セルづつジャンプすると、各エリア(連続範囲のこと)の
先頭セルですね。
列方向は 3セルづつジャンプしながら、27回。
こうして各エリアの先頭セルが求まりますから、
先頭セルから行方向に9セル Resizeしたセル範囲が対象エリアです。
Sub test3()
Dim n As Long
Dim y As Long, x As Long
Dim ss As String
Dim c As Range
Const Y0 = 8, YY = 25, Ystp = 16 '縦方向 最初の行番、繰り返し回数,Step
Const X0 = 5, XX = 27, Xstp = 3 '列方向 最初の列番、繰り返し回数,Step
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
For Each c In Cells(y, x).Resize(9)
ss = c.Value
If Len(ss) > 0 Then
n = c.Offset(, -1).Value
If Not dic.Exists(ss) Then
dic(ss) = n
ElseIf dic(ss) < n Then
dic(ss) = n
End If
End If
Next
Next
Next
For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
For Each c In Cells(y, x).Resize(9)
ss = c.Value
If Len(ss) > 0 Then
c.Offset(, -1).Value = dic(ss)
End If
Next
Next
Next
End Sub
|
|
kanabun
- 14/1/8(水) 13:18 -
