Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1255 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【75379】以前作って頂いた物の改変(複雑です) 初心者M 14/3/18(火) 11:09 質問[未読]
【75380】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/18(火) 12:49 発言[未読]
【75381】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/18(火) 13:47 質問[未読]
【75382】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/18(火) 19:24 発言[未読]
【75383】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/18(火) 19:40 発言[未読]
【75384】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/19(水) 10:03 お礼[未読]
【75385】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/19(水) 11:00 発言[未読]
【75386】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/19(水) 11:26 質問[未読]
【75387】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/19(水) 13:59 発言[未読]
【75388】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/19(水) 14:35 お礼[未読]
【75389】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/19(水) 14:37 お礼[未読]
【75390】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/19(水) 15:59 発言[未読]
【75391】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/19(水) 16:11 発言[未読]
【75392】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/19(水) 17:24 お礼[未読]
【75393】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/19(水) 20:11 発言[未読]
【75394】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/20(木) 9:13 質問[未読]
【75395】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/20(木) 9:34 発言[未読]
【75396】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/20(木) 13:21 お礼[未読]
【75397】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/20(木) 14:17 発言[未読]
【75398】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/20(木) 14:45 発言[未読]
【75399】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/20(木) 14:52 発言[未読]
【75400】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/20(木) 15:19 発言[未読]
【75402】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/20(木) 17:38 発言[未読]
【75403】Re:以前作って頂いた物の改変(複雑です) 初心者Ｍ 14/3/20(木) 17:56 発言[未読]
【75404】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/20(木) 19:08 発言[未読]
【75423】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/24(月) 9:23 質問[未読]
【75424】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 10:22 質問[未読]
【75425】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 10:33 発言[未読]
【75426】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/24(月) 10:40 発言[未読]
【75427】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 10:54 発言[未読]
【75428】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/24(月) 11:10 お礼[未読]
【75429】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 11:30 発言[未読]
【75430】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 11:40 発言[未読]
【75431】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/24(月) 11:49 発言[未読]
【75432】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 13:48 発言[未読]
【75433】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/24(月) 14:10 お礼[未読]
【75434】Re:以前作って頂いた物の改変(複雑です) kanabun 14/3/24(月) 17:38 発言[未読]
【75435】Re:以前作って頂いた物の改変(複雑です) 初心者M 14/3/25(火) 9:46 お礼[未読]
【75379】以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/18(火) 11:09 -
引用なし
パスワード
   度々すみません。
以前こちら、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)に変えて３回回したら上手く動いたのですが、それ以降が止まってしまいますし、何か違う気がします。

よろしければ、お知恵を貸していただけないでしょうか。
４月からの繁忙期に、これが自動化できると大変助かります。
【75380】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/18(火) 12:49 -
引用なし
パスワード
   ▼初心者M さん：

>それをまた、別のファイルで使うために改変しようとし、試行錯誤の末行き詰まってしまったので、申し訳ございませんがまたお知恵を貸して頂きたいです。

>　　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)に変えて３回回したら上手く動いたのですが、それ以降が止まってしまいますし、何か違う気がします。

サンプルの表を出して、
この表を こうしたいのだが、こうなってしまう
のように、
絵で説明してくださると、時間のあるとき考えてみるのですが...
【75381】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/18(火) 13:47 -
引用なし
パスワード
   ▼kanabun さん：

有り難うございます。

>サンプルの表を出して、
>この表を こうしたいのだが、こうなってしまう
>のように、
>絵で説明してくださると、時間のあるとき考えてみるのですが...


ざっくり、このようなイメージです。
もっと良い提示方法があれば、お教え頂けると助かります。表は、以下のような形です。
急いでおりませんので、お時間の有る時で全く問題ございません。

Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ

〜

７
＿＿＿＿＿＿＿＿＿
８　　　　　　　５|
　　　　　　　　　|
９　　　ア　　　２|
　　　　　　　　　|
10　　　　　　　７|
＿＿＿＿＿＿＿＿＿|
11　　　　　　　８|
　　　　　　　　　|
12　　　イ　　　４|
　　　　　　　　　|
13　　　　　　　９|
＿＿＿＿＿＿＿＿＿|
14　　　　　　　６|
　　　　　　　　　|
15　　　ウ　　　８|
　　　　　　　　　|
16　　　　　　　４|
＿＿＿＿＿＿＿＿＿|
17

１．このＣ９からＥ１６までの「３×９」のブロックが基本で、これが数十個、縦横に並んでいます。今つくろうとしているファイルでは、横２７，縦８４個あります(右下がＣＦ１３４４)が、他の、数が違うファイルでも使う可能性があります。これはＳＴＥＰ数を変えれば良いかと思います。

２．Ｃ列の数字が製造ライン台の記号で、Ｅ列の番号が必要製造数。ラインごとに、一番大きい数にまとめて作ってしまうイメージです。
　ただし、同じライン「ア」の中でも、たとえばＥ８の数は試作品、Ｅ９は製品、Ｅ１０は特別版、のように内容が違うので、別々に集計する必要があります。また、Ｄ９、Ｄ１２、Ｄ１５列に数字が入っていた場合は特別な処理が入るので、この場合は無視して飛ばす必要があります。この時、色を付けたいです。

２．まずＣ９の「ア」、Ｃ１２の「イ」、Ｃ１５の「ウ」だけを取り込み。

３．「ア」と同じラインがあれば、Ｅ８・Ｅ９・Ｅ１０に対応する数値を、それぞれシートの中で探してきて最大値にまとめる。

４．物によってラインに取り込める数が「４」や「８」と決まっているので(シートごとに固定)、もし「ア」が５個有るなどそれ以外の数値だった場合、エラー表示を出したい。


　以上が、大体のやりたいことになります。わかりにくい所がありましたら、申し訳ございませんが再度ご指摘頂きたいです。
　試行錯誤の結果については、前のレスの通りです。
　自分で頑張ってみるつもりだったのですが、使いたい時期が来月から、と迫ってきており、私の独力では２年くらいかかりそうな気がしたため、大変心苦しいのですがまたお力をお借りしたく、こちらに書き込ませていただきました。
【75382】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/18(火) 19:24 -
引用なし
パスワード
   ▼初心者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

あと、
>４．物によってラインに取り込める数が「４」や「８」と決まっているので(シートごとに固定)、もし「ア」が５個有るなどそれ以外の数値だった場合、エラー表示を出したい。

これについては処理してませんが、「物によってラインに取り込める数」という
のは、どこに書いてあるのですか？
【75383】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/18(火) 19:40 -
引用なし
パスワード
   なお、Dictionary は
C列の記号の後に 試作品、製品、特別品別を区別する記号を付したもので、
辞書のキーに登録していけば、dicを3つ用意しなくても済みます。

Sub test61() '1つのdicで済ます
　Dim n As Long
　Dim y As Long, x As Long '整数型は特別な場合を除いて Long がよい
　Dim i As Long, k As Long
　Dim ss As String, sk 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 As Object
　Set dic = 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行
　　　　　　　　sk = ss & k　'C列記号＋製品種別番号
　　　　　　　　n = WorksheetFunction. _
　　　　　　　　　　RoundUp(c.Offset(k - 2, 2).Value, -2)
　　　　　　　　If Not dic.Exists(sk) Then　'keyが無ければ登録
　　　　　　　　　　dic(sk) = n　　　　　　　 'その行の数値を登録
　　　　　　　　ElseIf dic(sk) < n Then　'すでにキーのあるとき
　　　　　　　　　　'この行のnがこれまでの最大値より大きければ
　　　　　　　　　　dic(sk) = 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(ss & k)
　　　　　　　Next k
　　　　　　End If
　　　　End If
　　　Next i
　　Next y
　Next x
　　
　MsgBox "持ち上げが完了しました。" & vbCr _
　　　& "掛け数の設定されている台は、手集計して下さい"

End Sub
【75384】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 10:03 -
引用なし
パスワード
   ▼kanabun さん：


ありがとうございます！まず、私のあの拙い説明で、あっさりと完璧なものを作成される技術に大感動です。
何度か試させていただきましたが、完璧に動作しているようです。
さらに、私にも分かるようにコメントまで付けて下さったお気遣いに、心より感謝いたします。これなら、アホな私でも分かりそうです。
本当に有り難うございます。


よろしければ２点質問させて下さい。

> '整数型は特別な場合を除いて Long がよい

では、これからLongを使います。初心者向けの教本には、Integerを使うのが一般的なように書かれていますが、これはどういった理由でしょうか？


最後に、Ｘ１セルに入っている数字「４」や「８」と、Ｃ列の記号や数字の数を比較する方法はありますか？
dicに入った値がどのように処理されるのかイマイチ分かっておらず、とっかかりだけでもお教えいただければ嬉しいです。

よろしくお願いいたします。
【75385】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 11:00 -
引用なし
パスワード
   ▼初心者M さん：

>ありがとうございます！まず、私のあの拙い説明で、あっさりと完璧なものを作成される技術に大感動です。
いや、物忘れがひどいので、以前のスレッドとそのとき作った検証用の Bookを
ディスクの中からひっぱり出してきて、ようやくこれまでの経過がおぼろげながら
よみがえってきたところです(-_-)

>
>よろしければ２点質問させて下さい。
>
>> '整数型は特別な場合を除いて Long がよい
>
> 初心者向けの教本には、Integerを使うのが一般的なように書かれていますが、これはどういった理由でしょうか？
Integer型は2バイト(16bits)、Long型は 4バイト(32bits) メモリーを使います。
メモリー領域としては Integerのほうが半分で済みますが、CPUが32bit(4バイト)
だと4バイトいっぺんにやり取りしたほうが処理が早くなります。Integer型デー
タだと、4バイトのデータから2バイト分だけ取り出す処理が余分に入る、といった
マイナスイメージになります。
ただ、変数のデータ型を宣言しないと Variant型となり、そのときには32バイト
も使いますから、Integer か Long かより、「変数は必ず適切な型を宣言して
使う」習慣をつけることのほうが、より台せつなことですけど。。。


>最後に、Ｘ１セルに入っている数字「４」や「８」と、Ｃ列の記号や数字の数を比較する方法はありますか？
>dicに入った値がどのように処理されるのかイマイチ分かっておらず、とっかかりだけでもお教えいただければ嬉しいです。
この件ですけど、
以前のコメントの
> ４．物によってラインに取り込める数が「４」や「８」と決まっているので
> (シートごとに固定)、もし「ア」が５個有るなどそれ以外の数値だった場合、
> エラー表示を出したい。
に対応するものですよね？
シートごとに C列(など)に出てくる記号の最大出現回数が決まっている(制限が
ある) ということですか？
【75386】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/19(水) 11:26 -
引用なし
パスワード
   ▼kanabun さん：


>以前のスレッドとそのとき作った検証用の Bookをディスクの中からひっぱり出してきて

大変なお手間をおかけしたようで、大変恐縮です。
ですが、おかげさまで手作業が大きく短縮されそうです。


>Integer型は2バイト(16bits)、Long型は 4バイト(32bits) メモリーを使います。
>メモリー領域としては Integerのほうが半分で済みますが、CPUが32bit(4バイト)
>だと4バイトいっぺんにやり取りしたほうが処理が早くなります。

今のＰＣが32bitなので、確かにこの方がよさそうですね。よく分かりました。
有り難うございます。


> 以前のコメントの
>> ４．物によってラインに取り込める数が「４」や「８」と決まっているので
>> (シートごとに固定)、もし「ア」が５個有るなどそれ以外の数値だった場合、
>> エラー表示を出したい。
>に対応するものですよね？
>シートごとに C列(など)に出てくる記号の最大出現回数が決まっている(制限が
>ある) ということですか？

これです。シートごとに可変です（大体４か８か１２）。
１枚のピザ（Ｃ列の記号ごとのピザ）から、製品を４枚取るか８枚取るか１２枚取るか・・・というようなイメージです。
なので４枚のシートでＣの同じ記号が５回出ていたら、エラーになるべき部分なのです。

余談ですが、Ｄ列の掛け数というもの（無視したもの）が入っていると、この４枚の内２枚を同じ物にしたり・・・という面倒な処理が入ることになり、かなり複雑になるので、ここは手集計ということにしました。（８と３と１で１２など）

というような説明でだいじょぶですかね。
よろしくお願いいたします。
【75387】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 13:59 -
引用なし
パスワード
   ▼初心者M さん：

C列の記号の出現回数をカウントする もうひとつ別の Dictionary を用意し
ここに出現回数をカウントしていくようにしてみました。

Sub test7() '品名 出現回数をカウント
　Dim n As Long
　Dim y As Long, x As 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") '特別品グループ
　Dim nc As Object
　Set nc = CreateObject("Scripting.Dictionary")
　Dim NCMAX As Long
　
　ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
　NCMAX = [X1].Value
　NCMAX = Val(InputBox$("最大出現回数", , NCMAX))
　If NCMAX < 1 Then Exit Sub
　
　'◆まず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　　　　　　　 'その行の数値を登録
　　　　　　　　　　nc(ss) = 1
　　　　　　　　ElseIf dic(k)(ss) < n Then　'すでにキーのあるとき
　　　　　　　　　　'この行のnがこれまでの最大値より大きければ
　　　　　　　　　　dic(k)(ss) = n　'最大値の更新
　　　　　　　　　　nc(ss) = nc(ss) + 1 '出現回数のカウント
　　　　　　　　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
　　　　　　　If nc(ss) > NCMAX Then
　　　　　　　　　c.Interior.Color = vbRed '制限数超過
　　　　　　　End If
　　　　　　End If
　　　　End If
　　　Next i
　　Next y
　Next x
　　
　MsgBox "持ち上げが完了しました。" & vbCr _
　　　& "掛け数の設定されている台は、手集計して下さい"

End Sub
【75388】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 14:35 -
引用なし
パスワード
   ▼kanabun さん：

>If nc(ss) > NCMAX Then
>　　c.Interior.Color = vbRed '制限数超過

重ね重ねありがとうございます。

さて、恐らく本当は超過分が赤くなるようにしてくださったのだと愚考しますが、私のシート上では上手く動いていないようです。
申し訳ございませんが私の頭では何が原因なのか全く分からないです。
ここまでして下さっただけでも充分すぎるほどですので、この先は本当にお時間が有ったらで構いませんが、お暇な時がもしお有りでしたらお教えいただきたく、お願い致します。

ここまでのことができれば、この先は全く急ぎません。
有り難うございました。
【75389】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 14:37 -
引用なし
パスワード
   追記します
「上手く動いていない」とは、色がつかず、超過分も問題なく処理されている、という状態です。


>▼kanabun さん：
>
>>If nc(ss) > NCMAX Then
>>　　c.Interior.Color = vbRed '制限数超過
>
>重ね重ねありがとうございます。
>
>さて、恐らく本当は超過分が赤くなるようにしてくださったのだと愚考しますが、私のシート上では上手く動いていないようです。
>申し訳ございませんが私の頭では何が原因なのか全く分からないです。
>ここまでして下さっただけでも充分すぎるほどですので、この先は本当にお時間が有ったらで構いませんが、お暇な時がもしお有りでしたらお教えいただきたく、お願い致します。
>
>ここまでのことができれば、この先は全く急ぎません。
>有り難うございました。
【75390】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 15:59 -
引用なし
パスワード
   ▼初心者M さん：

>さて、恐らく本当は超過分が赤くなるようにしてくださったのだと愚考しますが、私のシート上では上手く動いていないようです。
>申し訳ございませんが私の頭では何が原因なのか全く分からないです。

超過分というのを、ぼくが理解していない可能性があります。
　　
プロシージャの最後のほうに、以下を追加して、ご確認ください。

　Dim v
　For Each v In nc.Keys()
　　　Debug.Print v, nc(v)
　Next
　
>　 MsgBox "持ち上げが完了しました。" & vbCr _
>　　　& "掛け数の設定されている台は、手集計して下さい"
>
> End Sub

↑3行追加後のSub test7() を走らせると、こちらのイミディエイト・ウィンドウ
には こう表示されます。

A　　　　　　　9
B　　　　　　　17
C　　　　　　　10
D　　　　　　　13
L　　　　　　　12
M　　　　　　　13
Y　　　　　　　13
Z　　　　　　　10
K　　　　　　　9
X　　　　　　　17

1列目が C列相当に出現した記号の種類で、2列目が その出現回数です。
で、このシートの[X1]セルには 15 と書いてありますので、この例ですと、
記号 B と X と記入されているセルが 赤で塗りつぶされます。
意味が違ったら、再度説明願います。
【75391】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 16:11 -
引用なし
パスワード
   ついでに、こちらでテスト用のデータを作るのに使った
プロシージャです。
新規シートで、以下を走らせて、ダミーデータをつくったあと、
Sub test7()を実行してみてください。
たぶん 2つ前後の記号が赤で塗られると思います。

Sub test6用データ埋め込み()
　　Dim j As Long, n As Long, i As Long
　　Dim y As Long, x As Long
　　Dim Label As String
　　Dim c As Range
　　Dim r As Range
　　Const Y0 = 8, YY = 25, Ystp = 16 '縦方向 最初の行、繰り返し回数,Step
　　Const X0 = 3, XX = 27, Xstp = 3 '列方向 最初の列、繰り返し回数,Step
　　
　　Const Lo = 1, Hi = 6000
　　Randomize
　　
　　j = 0
　　Cells.Interior.ColorIndex = xlNone
　　Cells.ClearContents
　　For x = X0 To X0 + (XX - 1) * Xstp Step Xstp
　　　　For y = Y0 To Y0 + (YY - 1) * Ystp Step Ystp
　　　　　　Set r = Cells(y, x).Resize(9)
　　　　　　i = 0
　　　　　　For Each c In r
　　　　　　　　c(1, 3).Value = Int(Hi * Rnd() + Lo)
　　　　　　　　i = i + 1
　　　　　　　　Select Case i
　　　　　　　　　Case 2, 5, 8
　　　　　　　　　　j = j + 1: If j > 14 Then j = 1
　　　　　　　　　　c.Value = Mid$("ABCDABCDKLMXYZ", j, 1)
　　　　　　　　End Select
　　　　　　　　n = n + 1
　　　　　　Next
　　　　Next
　　Next
　　[X1].Value = 15
　　[D12,D28,D44,G12,J12].Value = 2
　　MsgBox n
End Sub
【75392】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 17:24 -
引用なし
パスワード
   ▼kanabun さん：

色々と有り難うございます。
当方この件に関してはアホなので、色々試してみることしか出来ないのですが、色々試した結果、今のところまだ「飛ばした部分の緑色は付くが、赤は付かない」状況です。また、kanabunさんのご認識は合っています。

kanabunさんに作っていただいた「Sub test6用データ埋め込み()」でも再現出来たのですが、一回赤を付けた後、同じシートでもう一度「Sub test7() '品名 出現回数をカウント」を実行すると、私のシートの用に緑しか付かないです。これって何かヒントになりませんかね？？

私のシートでは、全部コピー　→　新シートに「値のみ」貼り付け　→　実行　でも、「緑は付くが赤は付かない」状況です。また、上記の「Sub test6用データ埋め込み()」では、私の状況下でも１回めは上手く色が付きました。

あとは、Ｃ列の記号を数字→カタカナに変えてみたり、数を増やしてみたり、色々やってみたのですが、謎のままです。
他にやってみたほうが良いことがあればご指示頂けるとありがたいです。

また、本件これ以上は本当に急ぎません。こちらはkanabunさんのお手を煩わせているのでは、という申し訳ない気持ちで一杯ですので、ここで打ち切りでも一向に構いません。

よろしくお願いいたします。
有り難うございます。
【75393】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 20:11 -
引用なし
パスワード
   ▼初心者M さん：

>色々試した結果、今のところまだ「飛ばした部分の緑色は付くが、赤は付かない」状況です。また、kanabunさんのご認識は合っています。

> 「Sub test6用データ埋め込み()」では、私の状況下でも１回めは上手く色が付きました。
>kanabunさんに作っていただいた「Sub test6用データ埋め込み()」でも再現出来たのですが、一回赤を付けた後、同じシートでもう一度「Sub test7() '品名 出現回数をカウント」を実行すると、私のシートの用に緑しか付かないです。これって何かヒントになりませんかね？？

一度実行したら、その表は記号別最大値に書き換えられていますから、
再度実行するのは「意味ない」というか、そういう使い方は Sub test7() は
考えていません。
Sub test6用データ埋め込み() でテスト用データを作ったら、
そのシートをコピーして、複製したシートで集計を実行するようにして
ください。

>私のシートでは、全部コピー　→　新シートに「値のみ」貼り付け　→　実行　でも、「緑は付くが赤は付かない」状況です。

>↑3行追加後のSub test7() を走らせると、こちらのイミディエイト・ウィンドウ
> には こう表示されます。
>
>A　　　　　　　9
>B　　　　　　　17
>C　　　　　　　10
>D　　　　　　　13
>L　　　　　　　12
>M　　　　　　　13
>Y　　　　　　　13
>Z　　　　　　　10
>K　　　　　　　9
>X　　　　　　　17
>
>1列目が C列相当に出現した記号の種類で、2列目が その出現回数です。
>で、このシートの[X1]セルには 15 と書いてありますので、この例ですと、
>記号 B と X と記入されているセルが 赤で塗りつぶされます。

初心者M さんのシートで Sub test7() を走らせて、イミディエイト・ウィンドウ
に、 記号と出現回数が書き出されると思いますが、それをみて 何か
分りませんか？
【75394】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/20(木) 9:13 -
引用なし
パスワード
   ▼kanabun さん

すみませんでした。イミディエイト・ウィンドウがなんだか分からず、ググってからやろうと思っていたら別の検証に気を取られてしまいました。

私の環境下では「最大数＝４」に設定したところ、以下のようになりました。


1　　　　　　　1
5　　　　　　　1
7　　　　　　　1
10　　　　　　 1
12　　　　　　 1
15　　　　　　 1
17　　　　　　 1
19　　　　　　 1
21　　　　　　 1
24　　　　　　 1
26　　　　　　 1
28　　　　　　 1
30　　　　　　 1
33　　　　　　 1
36　　　　　　 1
38　　　　　　 1
40　　　　　　 1
43　　　　　　 1
46　　　　　　 1
47　　　　　　 1
2　　　　　　　2
3　　　　　　　2
6　　　　　　　1
16　　　　　　 2
18　　　　　　 1
20　　　　　　 1
25　　　　　　 1
27　　　　　　 1
29　　　　　　 1
37　　　　　　 1
39　　　　　　 1
41　　　　　　 1
44　　　　　　 3
48　　　　　　 1
13　　　　　　 1
31　　　　　　 1
34　　　　　　 1
9　　　　　　　1
14　　　　　　 2
23　　　　　　 1
45　　　　　　 3
4　　　　　　　2
42　　　　　　 2 1　　　　　 1
5　　　　　　　1
7　　　　　　　1
10　　　　　　 1
12　　　　　　 1
15　　　　　　 1
17　　　　　　 1
19　　　　　　 1
21　　　　　　 1
24　　　　　　 1
26　　　　　　 1
28　　　　　　 1
30　　　　　　 1
33　　　　　　 1
36　　　　　　 1
38　　　　　　 1
40　　　　　　 1
43　　　　　　 1
46　　　　　　 1
47　　　　　　 1
2　　　　　　　2
3　　　　　　　2
6　　　　　　　1
16　　　　　　 2
18　　　　　　 1
20　　　　　　 1
25　　　　　　 1
27　　　　　　 1
29　　　　　　 1
37　　　　　　 1
39　　　　　　 1
41　　　　　　 1
44　　　　　　 3
48　　　　　　 1
13　　　　　　 1
31　　　　　　 1
34　　　　　　 1
9　　　　　　　1
14　　　　　　 2
23　　　　　　 1
45　　　　　　 3
4　　　　　　　2
42　　　　　　 2

実際は、検証用に「５」を６個、「６」を５個、入れたので、これらが赤くなるはずです。
４以上と判断されたものが無かったから、反応しなかったのですね。

このような状況です。よろしくお願いいたします。
【75395】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 9:34 -
引用なし
パスワード
   ▼初心者M さん：


>私の環境下では「最大数＝４」に設定したところ、以下のようになりました。
>

>４以上と判断されたものが無かったから、反応しなかったのですね。
そのとおりです。

ですから、問題は、
>実際は、検証用に「５」を６個、「６」を５個、入れたので、これらが赤くなるはずです。
そうならないのはなぜか？
という点に絞られます。

これは、こちらで検証することができません。
【75396】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/20(木) 13:21 -
引用なし
パスワード
   kanabunさん

有り難うございました！
kanabunさんは、私の要望以上のものを仕上げてくださいましたので、これ以上は私で頑張ってみます。
もし、原因が究明出来た上で手に負えない場合は、またご助力願うかも知れませんが・・・。

その時は、是非またよろしくお願いいたします。
本当に有り難うございました。
【75397】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 14:17 -
引用なし
パスワード
   ▼初心者M さん：

>もし、原因が究明出来た上で手に負えない場合は、またご助力願うかも知れませんが・・・。
>
>その時は、是非またよろしくお願いいたします。

記号を既定数以上埋め込んだのに、セルの塗りつぶしがなされない。
問題点は絞られましたので、原因はほどなく明らかになるのではと
期待しています。また、今後のデバッグの参考になりますので、原因が
分ったら（そちらで解決できても）ぜひ、ここにご報告ください。
お願いします。
【75398】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/20(木) 14:45 -
引用なし
パスワード
   ▼kanabun さん：

もしかしたら、原因が分かったかも知れません。
上記の

>一度実行したら、その表は記号別最大値に書き換えられていますから、
>再度実行するのは「意味ない」というか、そういう使い方は Sub test7() は
>考えていません。

と、私が試した中で「４５」だけが「３」という数値だったのがヒントでした。
私の使っているシートでは、数値はある程度揃っているので、実は一切数値をいじらないセルも有るのです。その中で、「４５」だけはある程度数値がバラけていました。
なので試しに、Ｃ列に「１」を入力したものを５つ作って、意図的に全部バラバラの数値にしたところ、ちゃんと赤くなりました。

ということだったようです。
よろしくお願いいたします。
【75399】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 14:52 -
引用なし
パスワード
   >▼初心者M さん：

すこしくどいですが、面白い問題なので、再確認に意味で、いま問題になってい
る不具合をコメントしておきます。

たとえば、あなたが イミディエイト・ウィンドウに出力した記号と出現回数
のリストを記号でならびかえて 再表示しますと、以下のようです。

記号　　　　出現回数
1　　　　1
2　　　　2
3　　　　2
4　　　　2
5　　　　1
6　　　　1
7　　　　1
9　　　　1
10　　　　1
12　　　　1
13　　　　1
14　　　　2
15　　　　1
16　　　　2
17　　　　1
18　　　　1
19　　　　1
20　　　　1
21　　　　1
23　　　　1
24　　　　1
25　　　　1
26　　　　1
27　　　　1
28　　　　1
29　　　　1
30　　　　1
31　　　　1
33　　　　1
34　　　　1
36　　　　1
37　　　　1
38　　　　1
39　　　　1
40　　　　1
41　　　　1
42　　　　2
43　　　　1
44　　　　3
45　　　　3
46　　　　1
47　　　　1
48　　　　1

その記号の 「5」と「6」のところをみると ともに 1回しか出現しなかった
となっていますが、

> >実際は、検証用に「５」を６個、「６」を５個、入れたので、
イミディエイト・ウィンドウの出力は

記号　　　　出現回数
1　　　　1
2　　　　2
3　　　　2
4　　　　2
5　　　　6
6　　　　5
:　　　：
となり、「5」と「6」のセルは赤く塗りつぶされるはず、 なのに、実際は
塗りつぶしがされていない。

これが問題点ということですよね？

こちらが考えると、
1) 「５」を６個、「６」を５個 入れたシートが 別のシートだった。
2)　「５」を６個、「６」を５個 入れたセル位置が、ブロック範囲の
　　　2,5,8行目セルではなかった。

みたいなことしか思いつきません。
また、
Sub test6用データ埋め込み() で作成した表に対して実行したときは、
うまくいってるんですよね？
そしたら、その違いは何か？とか、そういう単純なことから、確認して
いってください。
【75400】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/20(木) 15:19 -
引用なし
パスワード
   ▼kanabun さん：

すみません、入れ違いになっしまったかもしれません。
とりあえず分かったことは、上にも書きましたが、それぞれの項目の、数値をバラバラにすると上手くカウントされるようだということです。

元々の表が「特別版」だけ数が微妙に違うなど、大した差のないデータであるため、このようになったのかな？と想像しています。
kanabunさんのコードで生成される表では数値がバラバラですよね。それで上手く動いているので、とりあえずそのような原因しか今のところ思い当たりませんでした。

なにかの参考になりますでしようか。
よろしくお願いいたします。
【75402】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 17:38 -
引用なし
パスワード
   ▼初心者M さん：

入れ違いで、レスをいただいていたようです m(_ _)m

>私の使っているシートでは、数値はある程度揃っているので、実は一切数値をいじらないセルも有るのです。

↑すみません。どういうことか、分りません。
　簡単な例を示していただけないでしょうか？

>とりあえず分かったことは、上にも書きましたが、それぞれの項目の、数値をバラバラにすると上手くカウントされるようだということです。
>
>元々の表が「特別版」だけ数が微妙に違うなど、大した差のないデータであるため、このようになったのかな？と想像しています。
>kanabunさんのコードで生成される表では数値がバラバラですよね。それで上手く動いているので、とりあえずそのような原因しか今のところ思い当たりませんでした。

↑再度、すみませんm(_ _)m 頭が固く、分りません。
　簡単な例を示していただけないでしょうか？
【75403】Re:以前作って頂いた物の改変(複雑です)
発言  初心者Ｍ  - 14/3/20(木) 17:56 -
引用なし
パスワード
   ▼kanabun さん：

すみません。まず、本日社外に出てしまったので、ファイルが手元に有りません。
実際の数値は来週になりますが、

１．Ｃ列に台番号「１」が入力された状態のものが５つあって

２．Ｅ列の上(試作数)が空白、真ん中(製品数)が「19400」、下(特別版)だけ「900」が２個と「840」が3個、というようなものだと、Ｃ列の最大値を「４」に設定してコードを実行すると

３．最大値合わせ、繰り上げ、Ｄ列に数値が入っていれば緑に変更、が行われる

４．でも、赤に変える部分には引っかかってこない

という状況だと思われます。
セルの番地違いのような、単純ミスではないかと思います。
【75404】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 19:08 -
引用なし
パスワード
   ▼初心者Ｍ さん：
こんばんは〜

>本日社外に出てしまったので、ファイルが手元に有りません。
それはかまいません、です。

>１．Ｃ列に台番号「１」が入力された状態のものが５つあって
>
>２．Ｅ列の上(試作数)が空白、真ん中(製品数)が「19400」、下(特別版)だけ「900」が２個と「840」が3個、というようなものだと、

↑このご説明が、すでに分かりません。

-----------------------------------------
　　　Ｃ　　　　Ｄ　　　　Ｅ　　
8　　　　　　　　　　　　　　　　
9　　1　　　　　　　　　19400　　
10　　　　　　　　　　　　 900　　
11　　　　　　　　　　　　　　　　
12　　1　　　　　　　　　　　　　　
13　　　　　　　　　　　　　　　　
14　　　　　　　　　　　　　　　　
15　　1　　　　　　　　　　　　　　
16　　　　　　　　　　　　　　　　
-----------------------------------------
のようなサンプルで示していただくことはできませんか？

（E列データに関して、こちらが勘ちがいをしていた可能性があります）
【75423】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/24(月) 9:23 -
引用なし
パスワード
   ▼kanabun さん：

　遅くなりまして申し訳ございません。
　以下の様なデータになっており、「１」の製品版＋特別版の組み合わせが11400＆1090＊３と、全く同じ数値が並んでおり、繰り上げが必要なのは１個だけです。

　これを全てバラバラの数値にしたら、上手く色が付きました。
　よろしくお願いいたします。


　　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　　Ｉ　　Ｊ　　Ｋ

〜

９　　1　　　　11400　　1　　　　　11400　　1　　　　8500

10　　　　　　　1090　　　　　　　　1090　　　　　　　910

〜

41　　6　　　　　8700　　6　　　　　7500　　1　　　　11400　　

42　　　　　　　　870　　　　　　　　660　　　　　　　1090

〜

73　　6　　　　　8700　　6　　　　　8700
　　　　　　　　　870　　　　　　　　700
74
【75424】Re:以前作って頂いた物の改変(複雑です)
質問  kanabun  - 14/3/24(月) 10:22 -
引用なし
パスワード
   ▼初心者M さん：おはようございます。

>　以下の様なデータになっており、「１」の製品版＋特別版の組み合わせが11400＆1090＊３と、全く同じ数値が並んでおり、繰り上げが必要なのは１個だけです。

では、8行目の 数値の列(E,H,K...) は 何が入っているのですか？
その位置にも 適当な数字(すべて同じ数字)を入れて、再度、試しましたが、
ちゃんと赤く塗りつぶされます。
「繰り上げが必要なのは１個だけです。」というのは、サンプルデータで
「IJK列の9,10行の」データということですよね？

>
>　　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　　Ｉ　　Ｊ　　Ｋ
>
>〜
>
>９　　1　　　　11400　　1　　　　　11400　　1　　　　8500
>
>10　　　　　　　1090　　　　　　　　1090　　　　　　　910
>
>〜
>
>41　　6　　　　　8700　　6　　　　　7500　　1　　　　11400　　
>
>42　　　　　　　　870　　　　　　　　660　　　　　　　1090
>
>〜
>
>73　　6　　　　　8700　　6　　　　　8700
>　　　　　　　　　870　　　　　　　　700
>74
【75425】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 10:33 -
引用なし
パスワード
   再現できないまま終わるのは悲しいので...
再度お伺いします。

[X1]に入っている数値の意味？

全部を調べたあと、C列など記号列の記号の出現回数が [X1]列の数値以上なら
赤で塗りつぶす。と考えてました。

E列など数値列の数値が同じとか、何も書かれていないとか、そういう数値列の
数値が影響して C列の記号を塗りつぶさなくなることってあるんですか？？
【75426】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/24(月) 10:40 -
引用なし
パスワード
   ▼kanabun さん：


>では、8行目の 数値の列(E,H,K...) は 何が入っているのですか？
>その位置にも 適当な数字(すべて同じ数字)を入れて、再度、試しましたが、
>ちゃんと赤く塗りつぶされます。

このファイルの場合、「試作品」と「製品」「特別版」は別々に作るので、８行目に数字が入っている場合は９，１０行目には何も入りませんし、その逆の場合も同じです。「試作品」だけのシート、「製品版（特別版）」だけのシート、というように、別物になります。


>「繰り上げが必要なのは１個だけです。」というのは、サンプルデータで
>「IJK列の9,10行の」データということですよね？

その通りです。ここをバラバラの数値にすると、上手く動いてくれるようなのですが・・・
【75427】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 10:54 -
引用なし
パスワード
   ▼初心者M さん：

>このファイルの場合、「試作品」と「製品」「特別版」は別々に作るので、８行目に数字が入っている場合は９，１０行目には何も入りませんし、その逆の場合も同じです。「試作品」だけのシート、「製品版（特別版）」だけのシート、というように、別物になります。
>
なるほど、そういうことでしたか。これについては了解です。

>>「繰り上げが必要なのは１個だけです。」というのは、サンプルデータで
>>「IJK列の9,10行の」データということですよね？
>
>その通りです。ここをバラバラの数値にすると、上手く動いてくれるようなのですが・・・
ここがやはり分りません(ToT)

記号の出現回数のカウントを １つにしましたので、
これを使って流すとどうなりますか？

Sub test72() '品名 出現回数をカウント
　Dim n As Long
　Dim y As Long, x As 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") '特別品グループ
　Dim nc As Object
　Set nc = CreateObject("Scripting.Dictionary")
　Dim NCMAX As Long
　
　ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
　NCMAX = [X1].Value
　NCMAX = Val(InputBox$("最大出現回数", , NCMAX))
　If NCMAX < 1 Then Exit Sub
　
　'◆まず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
　　　　　　　nc(ss) = nc(ss) + 1 '出現回数のカウント
　　　　　　　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
　　　　　　　If nc(ss) > NCMAX Then
　　　　　　　　　c.Interior.Color = vbRed '制限数超過
　　　　　　　End If
　　　　　　End If
　　　　End If
　　　Next i
　　Next y
　Next x
　　
　Dim v
　For Each v In nc.Keys()
　　　Debug.Print v, nc(v)
　Next
　
　MsgBox "持ち上げが完了しました。" & vbCr _
　　　& "掛け数の設定されている台は、手集計して下さい"

End Sub
【75428】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/24(月) 11:10 -
引用なし
パスワード
   ▼kanabun さん：


>記号の出現回数のカウントを １つにしましたので、
>これを使って流すとどうなりますか？

これだと、ばっちり赤くなりました！
今までは、何がまずかったのでしょうか？？
【75429】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 11:30 -
引用なし
パスワード
   ▼初心者M さん：
>
>これだと、ばっちり赤くなりました！
>今までは、何がまずかったのでしょうか？？

ああ、よかった。
こちらのミスでした。

>　　　　　　nc(ss) = nc(ss) + 1 '出現回数のカウント

（まえ 2か所にあったこの文を）一行にまとめ、位置を変えてみました。

それと、動作的には問題なくなったようですが、数値欄で空白セルを数値
0 として毎回 最大値をチェックするのはもったいないので、さらにコードを
見直してみますので、しばらくお待ちください。。。
【75430】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 11:40 -
引用なし
パスワード
   以下で試してみてください。
何かあれば、お願いします。

Sub test73() '品名 出現回数をカウント
　Dim n As Long, p As Long
　Dim y As Long, x As 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") '特別品グループ
　Dim nc As Object
　Set nc = CreateObject("Scripting.Dictionary")
　Dim NCMAX As Long
　
　ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
　NCMAX = [X1].Value
　NCMAX = Val(InputBox$("最大出現回数", , NCMAX))
　If NCMAX < 1 Then Exit Sub
　
　'◆まず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
　　　　　　　nc(ss) = nc(ss) + 1 '◆出現回数のカウント
　　　　　　　For k = 1 To 3　　'記号のある行の-1行〜2行までの3行
　　　　　　　　p = c.Offset(k - 2, 2).Value2 'E列の数値
　　　　　　　　If p > 0& Then　　　　'空白でなかったら
　　　　　　　　　　n = WorksheetFunction.RoundUp(p, -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
　　　　　　　　ElseIf Not dic(k).Exists(ss) Then
　　　　　　　　　　dic(k)(ss) = Empty
　　　　　　　　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
　　　　　　　If nc(ss) > NCMAX Then
　　　　　　　　　c.Interior.Color = vbRed '制限数超過
　　　　　　　End If
　　　　　　End If
　　　　End If
　　　Next i
　　Next y
　Next x
　　
　MsgBox "持ち上げが完了しました。" & vbCr _
　　　& "掛け数の設定されている台は、手集計して下さい"

End Sub
【75431】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/24(月) 11:49 -
引用なし
パスワード
   ▼kanabun さん：

>ああ、よかった。
>こちらのミスでした。

ミスなんですか？
ちゃんと動いていたようですが、前と何がどう変わって、何の動きが違うのか、理解するまで時間がかかりそうです。


>それと、動作的には問題なくなったようですが、数値欄で空白セルを数値
>0 として毎回 最大値をチェックするのはもったいないので、さらにコードを
>見直してみますので、しばらくお待ちください。。。

更に高速化するということですかね。
今でも充分速いように思うのですが、話が高度すぎて、もはやすごいという言葉しか出てこないです。
【75432】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 13:48 -
引用なし
パスワード
   > kanabun　- 14/3/24(月) 11:40

で試してみてください。
【75433】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/24(月) 14:10 -
引用なし
パスワード
   ▼kanabun さん：
>> kanabun　- 14/3/24(月) 11:40
>
>で試してみてください。


失礼しました。
とても軽快に動きますし、無視すべきもの、警告すべきものも完璧に表示されています。
本当に有り難うございました。

質問の趣旨から外れてしまうのですが、問題があるとすれば、運用する私の知識が全然追いついていないという１点です。
kanabunさんの様に、知識と技術のある親切な方にいつでも頼れるわけではないので、なんとか自分でも「こういうコードを使えば、こういうことができる」という知識を身につけたいのですが、どのような部分から手を付ければよいか、ご参考までにお教え頂けないでしょうか。例えば、「数値が入っているか」を判別するためにWorksheetFunctionを使うなど、私では到底思いつきません。

よろしくお願いいたします。
【75434】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/24(月) 17:38 -
引用なし
パスワード
   ▼初心者M さん：

>質問の趣旨から外れてしまうのですが、問題があるとすれば、運用する私の知識が全然追いついていないという１点です。
>kanabunさんの様に、知識と技術のある親切な方にいつでも頼れるわけではないので、なんとか自分でも「こういうコードを使えば、こういうことができる」という知識を身につけたいのですが、どのような部分から手を付ければよいか、ご参考までにお教え頂けないでしょうか。例えば、「数値が入っているか」を判別するためにWorksheetFunctionを使うなど、私では到底思いつきません。

これはぼくからの非常に個人的なお願いなのですが、
ぜひ習得してほしいのは Dictionaryオブジェクトの利用法です。
こちらはDictionaryの利便性、高速性にどっぷりつかっているので、
AdvancedFilter や ピボットテーブルの分野まで侵入して
Dictionaryを使ったコードを書くことがあります。
質問者のかたが Dictionaryをまるで知らないと、そのコードは
タダで作ってもらった変更の利かない道具ですが、すこしでも
Dictionaryを使ったコードの書き方をみていると、ははぁ、こ
こで、こういうふうにDictionaryを使うのだな。では、それを
まねて、こういう目的のためにDictionaryを使ってやろう。
という気になってきますので、かいとうする側としては非常に
提示しがいのある回答になります。
Dictionaryを一から説明せよ、と言われても、それはなかなか
難しいです。
具体例とともに、少しずつ慣れていくのが得策かと思います。
ぼくがそうでしたから。

●Dictionaryオブジェクトを使うと重複のあるリストから、一意の
リストを取得することができます。

みかん　　　　　　　　みかん
りんご　　　　　　　　りんご
バナナ　　　　　　　　バナナ
みかん　　　　＝＝⇒　なし
なし　　　　　　　　　
バナナ　　　　　　　　
みかん　　　　　　　　


● Dictionaryオブジェクトを使うと（今回のように）キーの
出現回数をカウントすることもできます。

For Each key In リスト
　　 dic(key) = dic(key) + 1
Next
[F1].Resize(dic.Count, 2).Value = Application.Transpose( _
　　Array(dic.Keys(), dic.Items())


● Dictionaryオブジェクトを使うと、集計作業ができます。
品名　　　売上
みかん　　1000
りんご　　1200
バナナ　　1500
みかん　　2000
なし　　　1000
バナナ　　5000
みかん　　2000

For Each 品名 In テーブル.列(1)
　　 dic(品名) = dic(品名) + 売上
Next
[F1].Resize(dic.Count, 2).Value = Application.Transpose( _
　　Array(dic.Keys(), dic.Items())

参考サイト
ht tp://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html
ht tp://officetanaka.net/excel/vba/tips/tips80.htm
【75435】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/25(火) 9:46 -
引用なし
パスワード
   ▼kanabun さん：

わざわざ参考サイトまで提示して下さって有り難うございます。
初心者向けの教本はいくつか買ったのですが、Dictionaryオブジェクトはkanabunさんに教えて頂くまで全く知りませんでした。とても便利なものですね。
今回私がやりたかったことにも合致していますし、必要なものだと思いました。

こちらで頑張って勉強してみたと思います。
本当に、有り難うございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1255 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free