| |
度々すみません。
以前こちら、kanabun様に作成していただいたマクロが非常に便利で、大変助かっております。
それをまた、別のファイルで使うために改変しようとし、試行錯誤の末行き詰まってしまったので、申し訳ございませんがまたお知恵を貸して頂きたいです。
ちょっと複雑です。説明が分り辛かったら申し訳ございません。
作っていただき、ちょっと改変して使っているのが、以下の内容です。
Ｃ列にある記号を取得し、同じものが記載されているＥ列の数字を、シート内の最大値に合わせるものです。
素人なりに解析や改変を頑張って、うまく行かない状態の痕跡も、そのまま載せておきます。(うまくいかない部分は動かないようにしてあります)
___________________________________
Sub test6()
Dim n As Long
Dim y As Integer, x As Integer
Dim ss As String
Dim c As Range
Const Y0 = 8, YY = 84, Ystp = 16 '縦方向 最初の行番・繰り返し回数・Step数
Const X0 = 3, 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(, 2).Value '数値取り込み
n = Application.WorksheetFunction.RoundUp(n, -2) '端数繰上げ
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 c.Offset(, 1).Value = 0 Then '掛け数が入力されていたら無視
If Len(ss) > 0 Then
c.Offset(, 2).Value = dic(ss)
'If c.Offset(, 2).Value = 0 Then '０なし
'GoTo nxt
'If c.Offset(, 1).Value <> 0 Then '←無視された行に色をつけたいが、うまく動かない
'c.Offset(, 1).Interior.Color = RGB(0, 128, 0)
'c.Offset(, 1).Interior.Coloindex = 10
'End If
'End If
End If
End If
'nxt:
Next
Next
Next
MsgBox ("持ち上げが完了しました。掛け数の設定されている台は、手集計して下さい")
End Sub
___________________________________
やりたいのは、上記の中にもある
１．無視された行に色を付ける
２．最初に読み込むセル(記号の有るセル)を、リサイズした９行の中でも「C9」「C12」「C15」のように３つずつだけにする
３．読み込んだ記号に対応した数値は、例えば「C9」に対し「E8」「E9」「E10」のように３つずつあり、これらを別々の数値として、それぞれ最大値に合わせる(３回回すイメージをしています)。
４．最後に、それぞれの記号に対し、書き込んだ回数をカウントし、特定の数値にに対して違っていたら警告を出したい。
２に関しては、読み込む部分のコードをResize(9)からOffset(1, 0)、Offset(4, 0)、Offset(7, 0)に変えて３回回したら上手く動いたのですが、それ以降が止まってしまいますし、何か違う気がします。
よろしければ、お知恵を貸していただけないでしょうか。
４月からの繁忙期に、これが自動化できると大変助かります。
|
|
初心者M
- 14/3/18(火) 11:09 -
