| |
▼初心者M さん：
>１．このＣ９からＥ１６までの「３×９」のブロックが基本で、これが数十個、縦横に並んでいます。今つくろうとしているファイルでは、横２７，縦８４個あります(右下がＣＦ１３４４)が、他の、数が違うファイルでも使う可能性があります。これはＳＴＥＰ数を変えれば良いかと思います。
>
>２．Ｃ列の数字が製造ライン台の記号で、Ｅ列の番号が必要製造数。ラインごとに、一番大きい数にまとめて作ってしまうイメージです。
> ただし、同じライン「ア」の中でも、たとえばＥ８の数は試作品、Ｅ９は製品、Ｅ１０は特別版、のように内容が違うので、別々に集計する必要があります。また、Ｄ９、Ｄ１２、Ｄ１５列に数字が入っていた場合は特別な処理が入るので、この場合は無視して飛ばす必要があります。この時、色を付けたいです。
>３．「ア」と同じラインがあれば、Ｅ８・Ｅ９・Ｅ１０に対応する数値を、それぞれシートの中で探してきて最大値にまとめる。
>
ここまでの処理ですが、
最大値はグループの1行目「試作品」用、2行目の「製品」用、3行目の「特別版」
用別々に求める必要があるということですから、
目的別に Dictionary を用意します。
→ dic でなくて、 dic(1) dic(2) dic(3)↓の3つを用意してやります。
元表をコピーしたダミーシートで、以下を試してみてください。
そのとき、
> Const Y0 = 8, YY = 84, Ystp = 16 '縦方向 最初の行番・Loop回数・Step数
> Const X0 = 3, XX = 27, Xstp = 3 '横方向 最初の列番・Loop回数・Step数
は実情に合わせて、変更願います。
Sub test6()
Dim n As Long
Dim y As Long, x As Long '整数型は特別な場合を除いて Long がよい
Dim i As Long, k As Long
Dim ss As String
Dim c As Range
Const Y0 = 8, YY = 84, Ystp = 16 '縦方向 最初の行番・Loop回数・Step数
Const X0 = 3, XX = 27, Xstp = 3 '横方向 最初の列番・Loop回数・Step数
Dim dic(1 To 3) As Object
Set dic(1) = CreateObject("Scripting.Dictionary") '試作品グループ
Set dic(2) = CreateObject("Scripting.Dictionary") '製品グループ
Set dic(3) = CreateObject("Scripting.Dictionary") '特別品グループ
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
'◆まずC列のキー別に、1段目、2段目、3段目別に、最大値を求める
For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
For i = 2 To 8 Step 3 '[C8]セルを1行目として
Set c = Cells(y, x).Item(i, 1) '2,5,8行目
'ただし D列に数字が入っていたら
If WorksheetFunction.IsNumber(c(1, 2)) Then
'「何もしない」塗りつぶすだけ
c.Resize(, 2).Interior.Color = vbGreen
Else
ss = c.Value
If Len(ss) > 0 Then
For k = 1 To 3 '記号のある行の-1行〜2行までの3行
n = WorksheetFunction. _
RoundUp(c.Offset(k - 2, 2).Value, -2)
If Not dic(k).Exists(ss) Then 'keyが無ければ登録
dic(k)(ss) = n 'その行の数値を登録
ElseIf dic(k)(ss) < n Then 'すでにキーのあるとき
'この行のnがこれまでの最大値より大きければ
dic(k)(ss) = n '最大値の更新
End If
Next k
End If
End If
Next i
Next y
Next x
'◆求まったキー別最大値で元表の数値列を更新
For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
For i = 2 To 8 Step 3 '[C8]セルを1行目として
Set c = Cells(y, x).Item(i, 1) '2,5,8行目
'ただし D列に数字が入っていたら
If WorksheetFunction.IsNumber(c(1, 2)) Then
'「何もしない」
Else
ss = c.Value
If Len(ss) > 0 Then
For k = 1 To 3 '記号のある行の-1行〜2行までの3行
c.Offset(k - 2, 2).Value = dic(k)(ss)
Next k
End If
End If
Next i
Next y
Next x
MsgBox "持ち上げが完了しました。" & vbCr _
& "掛け数の設定されている台は、手集計して下さい"
End Sub
あと、
>４．物によってラインに取り込める数が「４」や「８」と決まっているので(シートごとに固定)、もし「ア」が５個有るなどそれ以外の数値だった場合、エラー表示を出したい。
これについては処理してませんが、「物によってラインに取り込める数」という
のは、どこに書いてあるのですか？
|
|
kanabun
- 14/3/18(火) 19:24 -
