Excel VBA質問箱 IV

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

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


351 / 3841 ページ ←次へ | 前へ→

【75402】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 17:38 -

引用なし
パスワード
   ▼初心者M さん:

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

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

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

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

↑再度、すみませんm(_ _)m 頭が固く、分りません。
 簡単な例を示していただけないでしょうか?
・ツリー全体表示

【75401】計算式の答え 均等割り付け
質問  (´・ω・`)  - 14/3/20(木) 15:51 -

引用なし
パスワード
   いつもお世話になっております。
VBじゃないかもですが、、、
計算式の答えを均等割り付けしたい場合は
どうしたらよいですか??
=today()を均等割りしたいです。
宜しくお願いします
・ツリー全体表示

【75400】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/20(木) 15:19 -

引用なし
パスワード
   ▼kanabun さん:

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

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

なにかの参考になりますでしようか。
よろしくお願いいたします。
・ツリー全体表示

【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回しか出現しなかった
となっていますが、

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

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

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

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

みたいなことしか思いつきません。
また、
Sub test6用データ埋め込み() で作成した表に対して実行したときは、
うまくいってるんですよね?
そしたら、その違いは何か?とか、そういう単純なことから、確認して
いってください。
・ツリー全体表示

【75398】Re:以前作って頂いた物の改変(複雑です)
発言  初心者M  - 14/3/20(木) 14:45 -

引用なし
パスワード
   ▼kanabun さん:

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

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

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

ということだったようです。
よろしくお願いいたします。
・ツリー全体表示

【75397】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 14:17 -

引用なし
パスワード
   ▼初心者M さん:

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

記号を既定数以上埋め込んだのに、セルの塗りつぶしがなされない。
問題点は絞られましたので、原因はほどなく明らかになるのではと
期待しています。また、今後のデバッグの参考になりますので、原因が
分ったら(そちらで解決できても)ぜひ、ここにご報告ください。
お願いします。
・ツリー全体表示

【75396】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/20(木) 13:21 -

引用なし
パスワード
   kanabunさん

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

その時は、是非またよろしくお願いいたします。
本当に有り難うございました。
・ツリー全体表示

【75395】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/20(木) 9:34 -

引用なし
パスワード
   ▼初心者M さん:


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

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

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

これは、こちらで検証することができません。
・ツリー全体表示

【75394】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/20(木) 9:13 -

引用なし
パスワード
   ▼kanabun さん

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

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


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

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

このような状況です。よろしくお願いいたします。
・ツリー全体表示

【75393】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 20:11 -

引用なし
パスワード
   ▼初心者M さん:

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

> 「Sub test6用データ埋め込み()」では、私の状況下でも1回めは上手く色が付きました。
>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() を走らせて、イミディエイト・ウィンドウ
に、 記号と出現回数が書き出されると思いますが、それをみて 何か
分りませんか?
・ツリー全体表示

【75392】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 17:24 -

引用なし
パスワード
   ▼kanabun さん:

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

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

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

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

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

よろしくお願いいたします。
有り難うございます。
・ツリー全体表示

【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
・ツリー全体表示

【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 と記入されているセルが 赤で塗りつぶされます。
意味が違ったら、再度説明願います。
・ツリー全体表示

【75389】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 14:37 -

引用なし
パスワード
   追記します
「上手く動いていない」とは、色がつかず、超過分も問題なく処理されている、という状態です。


>▼kanabun さん:
>
>>If nc(ss) > NCMAX Then
>>  c.Interior.Color = vbRed '制限数超過
>
>重ね重ねありがとうございます。
>
>さて、恐らく本当は超過分が赤くなるようにしてくださったのだと愚考しますが、私のシート上では上手く動いていないようです。
>申し訳ございませんが私の頭では何が原因なのか全く分からないです。
>ここまでして下さっただけでも充分すぎるほどですので、この先は本当にお時間が有ったらで構いませんが、お暇な時がもしお有りでしたらお教えいただきたく、お願い致します。
>
>ここまでのことができれば、この先は全く急ぎません。
>有り難うございました。
・ツリー全体表示

【75388】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 14:35 -

引用なし
パスワード
   ▼kanabun さん:

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

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

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

ここまでのことができれば、この先は全く急ぎません。
有り難うございました。
・ツリー全体表示

【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
・ツリー全体表示

【75386】Re:以前作って頂いた物の改変(複雑です)
質問  初心者M  - 14/3/19(水) 11:26 -

引用なし
パスワード
   ▼kanabun さん:


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

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


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

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


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

これです。シートごとに可変です(大体4か8か12)。
1枚のピザ(C列の記号ごとのピザ)から、製品を4枚取るか8枚取るか12枚取るか・・・というようなイメージです。
なので4枚のシートでCの同じ記号が5回出ていたら、エラーになるべき部分なのです。

余談ですが、D列の掛け数というもの(無視したもの)が入っていると、この4枚の内2枚を同じ物にしたり・・・という面倒な処理が入ることになり、かなり複雑になるので、ここは手集計ということにしました。(8と3と1で12など)

というような説明でだいじょぶですかね。
よろしくお願いいたします。
・ツリー全体表示

【75385】Re:以前作って頂いた物の改変(複雑です)
発言  kanabun  - 14/3/19(水) 11:00 -

引用なし
パスワード
   ▼初心者M さん:

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

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


>最後に、X1セルに入っている数字「4」や「8」と、C列の記号や数字の数を比較する方法はありますか?
>dicに入った値がどのように処理されるのかイマイチ分かっておらず、とっかかりだけでもお教えいただければ嬉しいです。
この件ですけど、
以前のコメントの
> 4.物によってラインに取り込める数が「4」や「8」と決まっているので
> (シートごとに固定)、もし「ア」が5個有るなどそれ以外の数値だった場合、
> エラー表示を出したい。
に対応するものですよね?
シートごとに C列(など)に出てくる記号の最大出現回数が決まっている(制限が
ある) ということですか?
・ツリー全体表示

【75384】Re:以前作って頂いた物の改変(複雑です)
お礼  初心者M  - 14/3/19(水) 10:03 -

引用なし
パスワード
   ▼kanabun さん:


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


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

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

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


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

よろしくお願いいたします。
・ツリー全体表示

【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
・ツリー全体表示

351 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free