[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数の品目に対してチェックボックスONOFFで2通りの関数を使うコードについて』（たけ）
VBA初心者です、よろしくお願いいたします。
在庫管理表を作っており、質問させてください。
在庫管理表は（在庫管理シート）シート、部品情報は（型式・部品情報設定）シート、
品目はAF列から3列で1品目として表示、3列のうち1列目が入出庫、発注日等の項目列、
2列目が入出庫の数字をいれる列、3列目が在庫数となり、50品目表示させるようにしたいです。
在庫の計算式は、
1.（任意の日当たり使用数で毎日引き落としを行う計算）
2.（生産に応じて引き落としを行う計算式）
の2通りどちらでも計算できるようにしたいと思います。
Formulaプロパティーで品目の先頭セルと2行目に関数を入れ、2行目の関数よりAutoFillにて
任意の長さまで連続データを作成します。
チェックボックスにチェックが付いていれば、計算式1、そうでなければ計算式2としたいのですが
どのようにコードを造ればシンプルになるでしょうか
質問内容が分かりにくいかと思いますが
ご教授をよろしくお願いいたします。
下記のコードはチェックボックス72、73ですが
チェックボックスは72～121まで作成したいと思っています。
Private Sub CommandButton1_Click()
Dim lRow As Long
Row = Cells(Rows.Count, "J").End(xlUp).Row 'J列(日付け欄)の最終行を取得
Set ws1 = Worksheets("在庫管理シート")
Set ws2 = Worksheets("型式.部品情報設定")
If ws2.CheckBox72.Value = True Then
Range("AH45").Formula = "=型式.部品情報設定!AB12-型式.部品情報設定!AC12+在庫管理シート!AG45"
Range("AH46").Formula = "=在庫管理シート!AH45-型式.部品情報設定!$AC$12+在庫管理シート!AG46"
Range("AH46").AutoFill Range(Cells(46, 34), Cells(lRow, 34))
Range("AG42") = "日当たり使用数連動"
Else
Range("AH45").Formula = "=型式.部品情報設定!AB12-(L45*型式.部品数量設定!L12+M45*型式.部品数量設定!L13+N45*型式.部品数量設定!L14+O45*型式.部品数量設定!L15+P45*型式.部品数量設定!L16+Q45*型式.部品数量設定!L17+R45*型式.部品数量設定!L18+S45*型式.部品数量設定!L19+T45*型式.部品数量設定!L20+U45*型式.部品数量設定!L21+V45*型式.部品数量設定!L22+W45*型式.部品数量設定!L23+X45*型式.部品数量設定!L24+Y45*型式.部品数量設定!L25+Z45*型式.部品数量設定!L26+AA45*型式.部品数量設定!L27+AB45*型式.部品数量設定!L28+AC45*型式.部品数量設定!L29+AD45*型式.部品数量設定!L30+AE45*型式.部品数量設定!L31)+AG45"
Range("AH46").Formula = "=在庫管理シート!AH45-(L46*型式.部品数量設定!$L$12+M46*型式.部品数量設定!$L$13+N46*型式.部品数量設定!$L$14+O46*型式.部品数量設定!$L$15+P46*型式.部品数量設定!$L$16+Q46*型式.部品数量設定!$L$17+R46*型式.部品数量設定!$L$18+S46*型式.部品数量設定!$L$19+T46*型式.部品数量設定!$L$20+U46*型式.部品数量設定!$L$21+V46*型式.部品数量設定!$L$22+W46*型式.部品数量設定!$L$23+X46*型式.部品数量設定!$L$24+Y46*型式.部品数量設定!$L$25+Z46*型式.部品数量設定!$L$26+AA46*型式.部品数量設定!$L$27+AB46*型式.部品数量設定!$L$28+AC46*型式.部品数量設定!$L$29+AD46*型式.部品数量設定!$L$30+AE46*型式.部品数量設定!$L$31)+AG46"
Range("AH46").AutoFill Range(Cells(46, 34), Cells(lRow, 34))
Range("AG42") = "生産実績連動"
End If
If ws2.CheckBox73.Value = True Then
Range("AK45").Formula = "=型式.部品情報設定!AB13-型式.部品情報設定!AC13+在庫管理シート!AJ45"
Range("AK46").Formula = "=在庫管理シート!AK45-型式.部品情報設定!$AC$13+在庫管理シート!AJ46"
Range("AK46").AutoFill Range(Cells(46, 37), Cells(lRow, 37))
Else
Range("AK45").Formula = "=型式.部品情報設定!AB13-(L45*型式.部品数量設定!M12+M45*型式.部品数量設定!M13+N45*型式.部品数量設定!M14+O45*型式.部品数量設定!M15+P45*型式.部品数量設定!M16+Q45*型式.部品数量設定!M17+R45*型式.部品数量設定!M18+S45*型式.部品数量設定!M19+T45*型式.部品数量設定!M20+U45*型式.部品数量設定!M21+V45*型式.部品数量設定!M22+W45*型式.部品数量設定!M23+X45*型式.部品数量設定!M24+Y45*型式.部品数量設定!M25+Z45*型式.部品数量設定!M26+AA45*型式.部品数量設定!M27+AB45*型式.部品数量設定!M28+AC45*型式.部品数量設定!M29+AD45*型式.部品数量設定!M30+AE45*型式.部品数量設定!M31)+AJ45"
Range("AK46").Formula = "=在庫管理シート!AK45-(L46*型式.部品数量設定!$M$12+M46*型式.部品数量設定!$M$13+N46*型式.部品数量設定!$M$14+O46*型式.部品数量設定!$M$15+P46*型式.部品数量設定!$M$16+Q46*型式.部品数量設定!$M$17+R46*型式.部品数量設定!$M$18+S46*型式.部品数量設定!$M$19+T46*型式.部品数量設定!$M$20+U46*型式.部品数量設定!$M$21+V46*型式.部品数量設定!$M$22+W46*型式.部品数量設定!$M$23+X46*型式.部品数量設定!$M$24+Y46*型式.部品数量設定!$M$25+Z46*型式.部品数量設定!$M$26+AA46*型式.部品数量設定!$M$27+AB46*型式.部品数量設定!$M$28+AC46*型式.部品数量設定!$M$29+AD46*型式.部品数量設定!$M$30+AE46*型式.部品数量設定!M31)+AJ46"
Range("AK46").AutoFill Range(Cells(46, 37), Cells(lRow, 37))
End If
Worksheets("在庫管理シート").Select
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
答える前に確認ですが、今回もマルチポストでしょうか？
ルール上ダメとはなってないですが、マルチポストするならするで、きちんとご自身の手でマルチポスト先の議論も転記すべきだと思います。
でないとこちらしか見てない人には話が分かりません。
以下、ざっと眺めての感想など
■１
ActiveSheet依存（もしくは、Me依存）になっていますが意図したものでしょうか？
複数のシートを相手にしているので、対象シートを明示したほうがデバッグしやすいと思います。
■２
おそらくタイプミスでしょうが↓の変数名が間違っています
Row = Cells(Rows.Count, "J").End(xlUp).Row
■３
フィルコピーする方式を採っていますが、該当する範囲に直接数式を設定しても同じことかと思います。
Range("AH46").Formula = "=～～"
Range("AH46").AutoFill Range(Cells(46, 34), Cells(lRow, 34))
↓のように書いても（たぶん）同じ結果になる
Range("AH46:AH" & lRow).Formula = "=～～"
■４
こだわりがなければインデントをつけることを推奨します。
([[20230716075008]]でもコメント済ですが一応。）
■５
ざっとしか見てませんが↓のようになっていて、中身（～～の部分）は一緒ぽいので、Controlsとかでオブジェクトを特定すれば、チェックボックス72～121の分全部書く必要なんじゃないかなと思いました。
If ws2.CheckBox72.Value = True Then
～～
End If
If ws2.CheckBox73.Value = True Then
～～
End If
（もこな２ ） 2023/09/06(水) 12:52:39
ご返信ありがとうございます。
はい、前回の続きとなります。
前回は本当に失礼いたしました。
今回はこちらのみの投稿です。
アドバイスいただいた内容で確認します。
通常業務の合間でして時間がかかるかと思いますが
よろしくお願いいたします。
（たけ） 2023/09/06(水) 14:39:15
チェックボックスがFalseの時の数式がゴチャゴチャし過ぎてないですかね。 横データと縦データの掛け算の和なら、MMULT()で簡潔に算出できますけども。
例： H1セル =MMULT(A1:D1*1,F1:F4*1)
行 _A_ ___B__ _C_ _D_ _E_ _F_ _G_ _H_ 1 1 未入力 3 4 1 29 2 3 3 未入力 4 7
（半平太） 2023/09/06(水) 22:45:38
アドバイスありがとうございます。
MMULT関数を知りませんでした。
確かにごちゃごちゃしてますので、スッキリするなら
これから勉強してぜひ使ってみたいと思います。
ありがとうございます！
（たけ） 2023/09/07(木) 14:42:32
もこな２ 様
貴重なアドバイスありがとうございます。
■３
フィルコピーする方式を採っていますが、該当する範囲に直接数式を設定しても同じことかと思います。
オートフィルを使うと何故か実行ボタンを押したあとオートフィルの前で計算が止まってしまい、
2度押してオートフィルが実行されるという状態だったのがアドバイスいただいた計算式で改善されました。
■５
ざっとしか見てませんが↓のようになっていて、中身（～～の部分）は一緒ぽいので、Controlsとかで
オブジェクトを特定すれば、チェックボックス72～121の分全部書く必要なんじゃないかなと思いました。
Controlsを使ってスッキリできないかなと思ったのですが
良い方法が見つからなくて全部書いてしまいました。
こんな感じです。
これからMMULT関数を使ってスッキリさせたいと思います。
'チェックボックスONによって計算方式を変更（日当たり使用量連動 / 生産実績連動）
With ws1
If ws2.CheckBox72.Value = True Then
.Range("AH45").Formula = "=型式.部品情報設定!AB12-型式.部品情報設定!AC12+在庫管理シート!AG45"
.Range("AH46:AH" & lRow).Formula = "=在庫管理シート!AH45-型式.部品情報設定!$AC$12+在庫管理シート!AG46"
.Range("AF44").Interior.Color = RGB(0, 255, 0)
Else
.Range("AH45").Formula = "=型式.部品情報設定!AB12-(L45*型式.部品数量設定!L12+M45*型式.部品数量設定!L13+N45*型式.部品数量設定!L14+O45*型式.部品数量設定!L15+P45*型式.部品数量設定!L16+Q45*型式.部品数量設定!L17+R45*型式.部品数量設定!L18+S45*型式.部品数量設定!L19+T45*型式.部品数量設定!L20+U45*型式.部品数量設定!L21+V45*型式.部品数量設定!L22+W45*型式.部品数量設定!L23+X45*型式.部品数量設定!L24+Y45*型式.部品数量設定!L25+Z45*型式.部品数量設定!L26+AA45*型式.部品数量設定!L27+AB45*型式.部品数量設定!L28+AC45*型式.部品数量設定!L29+AD45*型式.部品数量設定!L30+AE45*型式.部品数量設定!L31)+AG45"
.Range("AH46:AH" & lRow).Formula = "=在庫管理シート!AH45-(L46*型式.部品数量設定!$L$12+M46*型式.部品数量設定!$L$13+N46*型式.部品数量設定!$L$14+O46*型式.部品数量設定!$L$15+P46*型式.部品数量設定!$L$16+Q46*型式.部品数量設定!$L$17+R46*型式.部品数量設定!$L$18+S46*型式.部品数量設定!$L$19+T46*型式.部品数量設定!$L$20+U46*型式.部品数量設定!$L$21+V46*型式.部品数量設定!$L$22+W46*型式.部品数量設定!$L$23+X46*型式.部品数量設定!$L$24+Y46*型式.部品数量設定!$L$25+Z46*型式.部品数量設定!$L$26+AA46*型式.部品数量設定!$L$27+AB46*型式.部品数量設定!$L$28+AC46*型式.部品数量設定!$L$29+AD46*型式.部品数量設定!$L$30+AE46*型式.部品数量設定!$L$31)+AG46"
End If
If ws2.CheckBox73.Value = True Then
.Range("AK45").Formula = "=型式.部品情報設定!AB13-型式.部品情報設定!AC13+在庫管理シート!AJ45"
.Range("AK46:AK" & lRow).Formula = "=在庫管理シート!AK45-型式.部品情報設定!$AC$13+在庫管理シート!AJ46"
.Range("AI44").Interior.Color = RGB(0, 255, 0)
Else
.Range("AK45").Formula = "=型式.部品情報設定!AB13-(L45*型式.部品数量設定!M12+M45*型式.部品数量設定!M13+N45*型式.部品数量設定!M14+O45*型式.部品数量設定!M15+P45*型式.部品数量設定!M16+Q45*型式.部品数量設定!M17+R45*型式.部品数量設定!M18+S45*型式.部品数量設定!M19+T45*型式.部品数量設定!M20+U45*型式.部品数量設定!M21+V45*型式.部品数量設定!M22+W45*型式.部品数量設定!M23+X45*型式.部品数量設定!M24+Y45*型式.部品数量設定!M25+Z45*型式.部品数量設定!M26+AA45*型式.部品数量設定!M27+AB45*型式.部品数量設定!M28+AC45*型式.部品数量設定!M29+AD45*型式.部品数量設定!M30+AE45*型式.部品数量設定!M31)+AJ45"
.Range("AK46:AK" & lRow).Formula = "=在庫管理シート!AK45-(L46*型式.部品数量設定!$M$12+M46*型式.部品数量設定!$M$13+N46*型式.部品数量設定!$M$14+O46*型式.部品数量設定!$M$15+P46*型式.部品数量設定!$M$16+Q46*型式.部品数量設定!$M$17+R46*型式.部品数量設定!$M$18+S46*型式.部品数量設定!$M$19+T46*型式.部品数量設定!$M$20+U46*型式.部品数量設定!$M$21+V46*型式.部品数量設定!$M$22+W46*型式.部品数量設定!$M$23+X46*型式.部品数量設定!$M$24+Y46*型式.部品数量設定!$M$25+Z46*型式.部品数量設定!$M$26+AA46*型式.部品数量設定!$M$27+AB46*型式.部品数量設定!$M$28+AC46*型式.部品数量設定!$M$29+AD46*型式.部品数量設定!$M$30+AE46*型式.部品数量設定!M31)+AJ46"
End If
If ws2.CheckBox74.Value = True Then
.Range("AN45").Formula = "=型式.部品情報設定!AB14-型式.部品情報設定!AC14+在庫管理シート!AM45"
.Range("AN46:AN" & lRow).Formula = "=在庫管理シート!AN45-型式.部品情報設定!$AC$14+在庫管理シート!AM46"
.Range("AL44").Interior.Color = RGB(0, 255, 0)
Else
.Range("AN45").Formula = "=型式.部品情報設定!AB14-(L45*型式.部品数量設定!N12+M45*型式.部品数量設定!N13+N45*型式.部品数量設定!N14+O45*型式.部品数量設定!N15+P45*型式.部品数量設定!N16+Q45*型式.部品数量設定!N17+R45*型式.部品数量設定!N18+S45*型式.部品数量設定!N19+T45*型式.部品数量設定!N20+U45*型式.部品数量設定!N21+V45*型式.部品数量設定!N22+W45*型式.部品数量設定!N23+X45*型式.部品数量設定!N24+Y45*型式.部品数量設定!N25+Z45*型式.部品数量設定!N26+AA45*型式.部品数量設定!N27+AB45*型式.部品数量設定!N28+AC45*型式.部品数量設定!N29+AD45*型式.部品数量設定!N30+AE45*型式.部品数量設定!N31)+AM45"
.Range("AN46:AN" & lRow).Formula = "=在庫管理シート!AN45-(L46*型式.部品数量設定!$N$12+M46*型式.部品数量設定!$N$13+N46*型式.部品数量設定!$N$14+O46*型式.部品数量設定!$N$15+P46*型式.部品数量設定!$N$16+Q46*型式.部品数量設定!$N$17+R46*型式.部品数量設定!$N$18+S46*型式.部品数量設定!$N$19+T46*型式.部品数量設定!$N$20+U46*型式.部品数量設定!$N$21+V46*型式.部品数量設定!$N$22+W46*型式.部品数量設定!$N$23+X46*型式.部品数量設定!$N$24+Y46*型式.部品数量設定!$N$25+Z46*型式.部品数量設定!$N$26+AA46*型式.部品数量設定!$N$27+AB46*型式.部品数量設定!$N$28+AC46*型式.部品数量設定!$N$29+AD46*型式.部品数量設定!$N$30+AE46*型式.部品数量設定!$N$31)+AM46"
End If
（たけ） 2023/09/07(木) 14:58:51
■６
全文引用してコメントされなくて結構です。
引用符がついてなくて、どちらの発言かぱっと見わかりませんし、何より長くなって読みづらいです。
■７
＞Controlsを使ってスッキリできないかなと思ったのですが
＞良い方法が見つからなくて全部書いてしまいました。
話が理解できません。
"思った"ならそうすればよいとおもいますが、"良い方法"ではないと判断したということでしょうか？
■８
「2023/09/07(木) 14:58:51」に提示したコードは、どういった意図がありますか？
インデントを付けるのはポリシーに反するので付けませんという意思表示なら好きにすればよいですが、その場合でも、質問掲示板でわざわざ見づらくして提示するメリットはあまり無いとおもいます。
（もこな２ ） 2023/09/08(金) 09:01:36
＞.Range("AH46:AH" & lRow).Formula = "=・・+AE46*型式.部品数量設定!$L$31)+AG46"
: :
＞.Range("AK46:AK" & lRow).Formula = "=・・+AE46*型式.部品数量設定!M31)+AJ46"
: :
＞.Range("AN46:AN" & lRow).Formula = "=・・+AE46*型式.部品数量設定!$N$31)+AM46"
AK列だけ「M31」と相対参照になっていますけど、マズくないですか？ 下にコピーすると、M32、M33、・・とズレれて行きますよ。
（半平太） 2023/09/08(金) 09:51:41
Controlsについて、この度の関数でどのように使ってよいか
使い方が分からなかったということです。
インデントについて、見づらく申し訳ありません
ポリシーとかはありませんのでインデントをつけて投稿するようにします。
（たけ） 2023/09/08(金) 11:06:26
修正しました。
ありがとうございます！
（たけ） 2023/09/08(金) 11:07:36
規則性があるよな、無いような・・とにかく、ややこしい。
MMULTを使った場合 ※数式の正解が示されないので推測で作式 サンプルデータの提示がないので、検証未済。
Private Sub CommandButton1_Click()
Const fmlTrueAH45 As String = "=型式.部品情報設定!#AB12♪#-型式.部品情報設定!#AC12♪#+在庫管理シート!#AG45♪#"
Const fmlTrueAH46 As String = "=在庫管理シート!#AH45♪#-型式.部品情報設定!#$AC$12♪#+在庫管理シート!#AG46♪#"
Const fmlFalseAH45 As String = "=型式.部品情報設定!#AB12♪#-MMULT(L45:AE45*1,型式.部品数量設定!#L12:L31♪#*1)+#AG45♪#"
Const fmlFalseAH46 As String = "=在庫管理シート!#AH45♪#-MMULT(L46:AE46*1,型式.部品数量設定!#$L$12:$L$31♪#*1)+#AG46♪#"
Dim adrAry, argAry
Dim lRow As Long, i As Long, ckBxVal As Boolean
Dim fml As String
Dim OLEobj As Object, dicT As Object
Dim shift As Long, def As Long
adrAry = Split("AB12,AC12,AG45,AH45,$AC$12,AG46,AB12,L45:AE45,L12:L31,AG45,AH45,L46:AE46,$L$12:$L$31,AG46", ",")
argAry = Split("Dummy,1 0 0 0,1 0 0 0,0 3 0 0,0 3 0 0,1 0 $ $,0 3 0 0,1 0 0 0,0 0 0 0,0 1 0 0,0 3 0 0,0 3 0 0,0 0 0 0,0 1 $ $,0 3 0 0", ",")
Set ws1 = Worksheets("在庫管理シート")
Set ws2 = Worksheets("型式.部品情報設定")
Set dicT = CreateObject("Scripting.Dictionary")
lRow = Cells(Rows.Count, "J").End(xlUp).Row 'J列(日付け欄)の最終行を取得
For Each OLEobj In ws2.OLEObjects
If OLEobj.Name Like "CheckBox*" Then
dicT(Replace(OLEobj.Name, "CheckBox", "")) = OLEobj.Object.Value
End If
Next OLEobj
For i = 72 To 121 '真偽確認(テスト用)
Debug.Print i, dicT(CStr(i))
If IsEmpty(dicT(CStr(i))) Then
MsgBox "「CheckBox" & i & "」が見当たりません。処理中止。"
Exit Sub
End If
Next
With ws1
For i = 72 To 121
def = i - 72
shift = (i - 72) * 3
ckBxVal = dicT(CStr(i))
If ckBxVal = True Then
.Range("AH45").Offset(0, shift).Formula = getAddress(fmlTrueAH45, adrAry, argAry, def)
.Range("AH46:AH" & lRow).Offset(0, (i - 72) * 3).Formula = getAddress(fmlTrueAH46, adrAry, argAry, def)
.Range("AF44").Offset(0, shift).Interior.Color = RGB(0, 255, 0)
.Range("AG42").Offset(0, shift) = "日当たり使用数連動"
Else
.Range("AH45").Offset(0, shift).Formula2 = getAddress(fmlFalseAH45, adrAry, argAry, def)
.Range("AH46:AH" & lRow).Offset(0, (i - 72) * 3).Formula2 = getAddress(fmlFalseAH46, adrAry, argAry, def)
.Range("AG42").Offset(0, shift) = "生産実績連動"
End If
Next i
End With
dicT.RemoveAll
Worksheets("在庫管理シート").Select
End Sub
Private Function getAddress(ByVal fml, adrAry, argAry, def As Long)
Dim Part, Patern
Dim adrLookFor As String
Dim adrSpl
Dim i As Long
Dim offAbs
Dim adrCombined
For Each Part In Split(fml, "#")
If Right(Part, 1) = "♪" Then
adrLookFor = Left(Part, Len(Part) - 1)
Patern = argAry(Application.Match(adrLookFor, adrAry, 0))
offAbs = Split(Patern) 'パターンを分解する
adrSpl = Split(adrLookFor & ":", ":") '強制的に配列にする
For i = 0 To UBound(adrSpl) - 1
adrSpl(i) = Application.Range(adrSpl(i)).Offset(offAbs(0) * def, offAbs(1) * def).Address(offAbs(2) = "$", offAbs(3) = "$")
Next i
adrCombined = Replace(Application.Trim(Join(adrSpl, " ")), " ", ":")
fml = Replace(fml, "#" & Part & "#", adrCombined)
End If
Next
getAddress = fml
End Function
（半平太） 2023/09/08(金) 20:30:40
これはすごいですね
ありがとうございます！
自分の浅すぎる知識では
さっぱりコードの意味が分かりません。
ちょっとやってみます。
（たけ） 2023/09/09(土) 18:45:10
動きましたが、63行目で計算が途切れて、
再度実行ボタン押下で全て計算してくれます。
未だコードの中身も分かっていない状態でして
造っていただいたコードが何なのか調べてみたいと思います。
ありがとうございます。
（たけ） 2023/09/10(日) 08:25:12
＞動きましたが、63行目で計算が途切れて、 ＞再度実行ボタン押下で全て計算してくれます。
何なのでしょうね・・？
処理開始時に計算方法を「手動」、終わったら「自動」に戻すのがいいかも知れません。
つまり、
Application.Calculation = xlManual ’←1行追加挿入
With ws1
：：
End With
Application.Calculation = xlAutomatic ’←1行追加挿入
＞未だコードの中身も分かっていない状態でして ＞造っていただいたコードが何なのか調べてみたいと思います。
まず、以下のチェックをしてください。 (!)数式が想定通りセルに入力されているか (2)MMULTの関数で算出した値は、従来と同じ値を算出しているか
全部チェックするのは大変なので、"CheckBox120" と "CheckBox121" の2つについて、 それぞれチェック入りと無しにして、その列に間違いがないか確認すればいいと思います。
（半平太） 2023/09/10(日) 09:43:36
"CheckBox120" と "CheckBox121"についてチェックしましたが
やはり、数式が63行目で変わっております。
121行目
FY62=在庫管理シート!FY61-型式.部品情報設定!$AC$61+在庫管理シート!FX62
FY63=在庫管理シート!FY62-MMULT(L63:AE63*1,型式.部品数量設定!$BI$12:$BI$31*1)+FX63
処理開始時に計算方法を「手動」、終わったら「自動」に戻す方法も試しましましたが
この症状は変わりませんでした。
全く知識は無いのですが、最初オートフィルを使うと何故か実行ボタンを押したあとオートフィルコードを入れた部分で計算が止まってしまい、
実行ボタンを2度押してオートフィル関数が実行されるという状態だったので、なんとなく似ているなと思いました。
ちなみにこの症状は もこな２様 に以下のアドバイスをいただいて解消しています。
Range("AH46").Formula = "=～～"
Range("AH46").AutoFill Range(Cells(46, 34), Cells(lRow, 34))
↓のように書いても（たぶん）同じ結果になる
Range("AH46:AH" & lRow).Formula = "=～～"
（たけ） 2023/09/10(日) 21:07:03
行の途中で、数式の種類が変わると言うのは想像しがたいです。
そのシートモジュールに別のVBAが書かれてないですか？ 例えば、こんなもの。 Private Sub Worksheet_Change(ByVal Target As Range) ＞ちなみにこの症状は もこな２様 に以下のアドバイスをいただいて解消しています。
私のコードもその方式で書いていますので、同じ様にならないと言うのは、何か解せないですねぇ。
72から121まで、50個のチェックボックスがありますが、 63行目で計算が途切れて実行ボタン押下したのも、50回やったんですか？
（半平太） 2023/09/10(日) 22:14:14
"在庫管理シート"にチェンジイベント作っています。
これが原因でしょうか？
63行目で計算が途切れたあと、もう一回実行キーを押すと
正常に最後まで計算されます。
（たけ） 2023/09/10(日) 22:31:38
＞"在庫管理シート"にチェンジイベント作っています。 ＞これが原因でしょうか？
大いに関係あるでしょうね。 一時的にイベントを抑止した方が無難です。
Application.Calculation = xlManual ’
Application.EnableEvents = False ’←更に1行追加挿入
With ws1
：：
End With
Application.EnableEvents = True ’←更に1行追加挿入
Application.Calculation = xlAutomatic ’
（半平太） 2023/09/10(日) 23:30:24
やってみましたが、
チェックボックスTrue→False の時だけ同じ症状でした。
False→Trueの時はでなくなりました。
（たけ） 2023/09/11(月) 12:30:41
＞チェックボックスTrue→False の時だけ同じ症状でした。 ＞False→Trueの時はでなくなりました。
ちょっと意味が呑み込めないのですが、 「→」の矢印はどう云う意味なんですか？
当方は、CommandButton1をクリックして、 以下の処理をするマクロを作成するものと思っているのですが・・ 「CheckBox72からCheckBox121まで、各Valueに応じて、対応する数式を一気に50列埋める」
もしかして、1列限定の処理の話なんですか？
（半平太） 2023/09/11(月) 14:41:14
言葉足らずですみません。
CheckBox72からCheckBox121 の各チェックボックスに対して
チェック無しからチェックを付けてCommandButton1をクリックしたとき、
対応する50品目に対して正しく計算が行われました。
反対に、チェック有りからチェック無にした場合
各品目、62行目までは正しく計算されますが、
63行目からは前の計算式のままということなんです。
伝わりますでしょうか。
（たけ） 2023/09/11(月) 14:55:04
＞チェック有りからチェック無にした場合 ＞各品目、62行目までは正しく計算されますが、 ＞63行目からは前の計算式のままということなんです。
それは後で考えるとして、 再実行ボタン押下を余儀なくされると言う現象はどうなりましたか？
＞半平太 様 ↑ 「さん」づけでお願いします。
（半平太） 2023/09/11(月) 15:10:22
はい、再実行ボタン押下は相変わらずです。
（たけ） 2023/09/11(月) 15:12:38
Private Sub CommandButton1_Click()
Dim A As Range
Dim B As Range
Set ws1 = Worksheets("在庫管理シート")
Set ws2 = Worksheets("型式.部品情報設定")
Set A = ws1.Columns(12)
Set B = ws1.Range("AF:AH")
'日付の取得
With ws2
If .CommandButton1.Caption = "切替（日付指定）" Then
.年度指定
.日付指定
.曜日取得
.土日行の非表示
ElseIf .CommandButton1.Caption = "切替（年度指定）" Then
.日付指定
.曜日取得
.土日行の非表示
End If
End With
Dim i3 As Integer, v As Integer
v = 0
For i3 = 1 To 20
If ws2.OLEObjects("CheckBox" & i3).Object.Value = False Then
A.Offset(0, v).Interior.ColorIndex = 15
A.Offset(0, v).EntireColumn.Hidden = True
Else
A.Offset(0, v).Interior.ColorIndex = 0
A.Offset(0, v).EntireColumn.Hidden = False
End If
v = v + 1
Next i3
Dim i2 As Integer
v = 0
For i2 = 21 To 70
If ws2.OLEObjects("CheckBox" & i2).Object.Value = False Then
B.Offset(0, v).Interior.ColorIndex = 15
B.Offset(0, v).EntireColumn.Hidden = True
Else
B.Offset(0, v).Interior.ColorIndex = 0
B.Offset(0, v).EntireColumn.Hidden = False
End If
v = v + 3
Next i2
Const fmlTrueAH45 As String = "=型式.部品情報設定!#AB12♪#-型式.部品情報設定!#AC12♪#+在庫管理シート!#AG45♪#"
Const fmlTrueAH46 As String = "=在庫管理シート!#AH45♪#-型式.部品情報設定!#$AC$12♪#+在庫管理シート!#AG46♪#"
Const fmlFalseAH45 As String = "=型式.部品情報設定!#AB12♪#-MMULT(L45:AE45*1,型式.部品数量設定!#L12:L31♪#*1)+#AG45♪#"
Const fmlFalseAH46 As String = "=在庫管理シート!#AH45♪#-MMULT(L46:AE46*1,型式.部品数量設定!#$L$12:$L$31♪#*1)+#AG46♪#"
Dim adrAry, argAry
Dim lRow As Long, i As Long, ckBxVal As Boolean
Dim fml As String
Dim OLEobj As Object, dicT As Object
Dim shift As Long, def As Long
adrAry = Split("AB12,AC12,AG45,AH45,$AC$12,AG46,AB12,L45:AE45,L12:L31,AG45,AH45,L46:AE46,$L$12:$L$31,AG46", ",")
argAry = Split("Dummy,1 0 0 0,1 0 0 0,0 3 0 0,0 3 0 0,1 0 $ $,0 3 0 0,1 0 0 0,0 0 0 0,0 1 0 0,0 3 0 0,0 3 0 0,0 0 0 0,0 1 $ $,0 3 0 0", ",")
Set ws1 = Worksheets("在庫管理シート")
Set ws2 = Worksheets("型式.部品情報設定")
Set dicT = CreateObject("Scripting.Dictionary")
lRow = Cells(Rows.Count, "J").End(xlUp).Row 'J列(日付け欄)の最終行を取得
For Each OLEobj In ws2.OLEObjects
If OLEobj.Name Like "CheckBox*" Then
dicT(Replace(OLEobj.Name, "CheckBox", "")) = OLEobj.Object.Value
End If
Next OLEobj
For i = 72 To 121 '真偽確認(テスト用)
Debug.Print i, dicT(CStr(i))
If IsEmpty(dicT(CStr(i))) Then
MsgBox "「CheckBox" & i & "」が見当たりません。処理中止。"
Exit Sub
End If
Next
Application.Calculation = xlManual
Application.EnableEvents = False
With ws1
For i = 72 To 121
def = i - 72
shift = (i - 72) * 3
ckBxVal = dicT(CStr(i))
If ckBxVal = True Then
.Range("AH45").Offset(0, shift).Formula = getAddress(fmlTrueAH45, adrAry, argAry, def)
.Range("AH46:AH" & lRow).Offset(0, (i - 72) * 3).Formula = getAddress(fmlTrueAH46, adrAry, argAry, def)
.Range("AF44").Offset(0, shift).Interior.Color = RGB(0, 255, 0)
.Range("AG42").Offset(0, shift) = "日当たり使用数連動"
Else
.Range("AH45").Offset(0, shift).Formula2 = getAddress(fmlFalseAH45, adrAry, argAry, def)
.Range("AH46:AH" & lRow).Offset(0, (i - 72) * 3).Formula2 = getAddress(fmlFalseAH46, adrAry, argAry, def)
.Range("AG42").Offset(0, shift) = "生産実績連動"
End If
Next i
End With
Application.EnableEvents = True
Application.Calculation = xlAutomatic
dicT.RemoveAll
Worksheets("在庫管理シート").Select
End Sub
Private Function getAddress(ByVal fml, adrAry, argAry, def As Long)
Dim Part, Patern
Dim adrLookFor As String
Dim adrSpl
Dim i As Long
Dim offAbs
Dim adrCombined
For Each Part In Split(fml, "#")
If Right(Part, 1) = "♪" Then
adrLookFor = Left(Part, Len(Part) - 1)
Patern = argAry(Application.Match(adrLookFor, adrAry, 0))
offAbs = Split(Patern) 'パターンを分解する
adrSpl = Split(adrLookFor & ":", ":") '強制的に配列にする
For i = 0 To UBound(adrSpl) - 1
adrSpl(i) = Application.Range(adrSpl(i)).Offset(offAbs(0) * def, offAbs(1) * def).Address(offAbs(2) = "$", offAbs(3) = "$")
Next i
adrCombined = Replace(Application.Trim(Join(adrSpl, " ")), " ", ":")
fml = Replace(fml, "#" & Part & "#", adrCombined)
End If
Next
getAddress = fml
End Function
（たけ） 2023/09/11(月) 15:20:24
＞63行目で計算が途切れたあと、もう一回実行キーを押すと
この時、ご提示のプログラムのどの行で止まっていますか？
（半平太） 2023/09/11(月) 15:45:22
エラーなどは起きておらず止まっていないです。
（たけ） 2023/09/11(月) 17:22:14
話が見えません。では、何故再実行するんですか？
プログラムのミッションは、下記で取得した行(lrow)までで完了となります。
＞ lRow = Cells(Rows.Count, "J").End(xlUp).Row 'J列(日付け欄)の最終行を取得
lRow が62なら62行目までが正しい。
再度実行しても結果は同じハズですが、 そうじゃなければlRowが1回目と2回目で異なると言うことになりますが、 それは私のコードとは無関係の問題です。
取り敢えず、以下に変更して、1回目と2回目が異なることを確認し、 何故異なるのか (こちらでは分からないので) そちらでチェックしてください。
Application.Calculation = xlManual
Application.EnableEvents = False
MsgBox "最終「" & lRow & "」行目まで数式を入力します。" ’←確認の為1時的に表示させる文を挿入
（半平太） 2023/09/11(月) 17:55:15
実行ボタンで
62行目まで数式を入力します。
再度押して、406行目まで数式を入力します
となります。ではJ列最終行の取得に問題があるのでしょうか・・
（たけ） 2023/09/11(月) 18:48:00
＞ではJ列最終行の取得に問題があるのでしょうか・・
当然の帰結ですね。
J列の日付欄の最終行が1回目と2回目の間で変化していると言うことです。
日付欄を消したり、書き込んだりしているプログラムがどこかにあるので、それを修正するか、 または 日付欄なんか見ないでも確実な最終行が分かる方策が別にあれば、そっちを採用するか
（半平太） 2023/09/11(月) 19:12:38
＞ If .CommandButton1.Caption = "切替（日付指定）" Then ＞ .年度指定 ＞ .日付指定 ＞ .曜日取得 ＞ .土日行の非表示 ＞ ElseIf .CommandButton1.Caption = "切替（年度指定）" Then ＞ .日付指定 ＞ .曜日取得 ＞ .土日行の非表示 ＞ End If
この辺りも怪しいなぁ・・
行を非表示にすると、 Cells(Rows.Count, "J").End(xlUp).Row とやっても、実際の最終行を素通りして、もっと上の表示行を返してきます。
（半平太） 2023/09/11(月) 19:18:21
もし、非表示行を作ったのが原因ならば、以下の変更でいいでしょう。
＞lRow = Cells(Rows.Count, "J").End(xlUp).Row 'J列(日付け欄)の最終行を取得
↓
lRow = Application.Match(9 ^ 9, Columns("J")) 'J列(日付け欄)の最終行を取得
（半平太） 2023/09/11(月) 19:52:30
lRow = Application.Match(9 ^ 9, Columns("J")) 'J列(日付け欄)の最終行を取得
でやってみましたが同じ結果でした・・
（たけ） 2023/09/11(月) 20:40:31
であれば、これをそちらで調べるしかないでしょう。 ↓ 日付欄を消したり、書き込んだりしているプログラムがどこかにあるので、それを修正するか、 または 日付欄なんか見ないでも確実な最終行が分かる方策が別にあれば、そっちを採用するか （半平太） 2023/09/11(月) 20:46:34
承知しました。
調べてみます。いろいろお手数をおかけしてすみません。
ありがとうございます。
（たけ） 2023/09/11(月) 20:50:29
■９
＞Controlsを使ってスッキリできないかなと思ったのですが
＞良い方法が見つからなくて全部書いてしまいました。
「2023/09/11(月) 15:20:24」に提示されたコードを拝見してようやく理解できました。
（【ユーザーフォーム】のモジュールであればControlsが使えたけど、今回はシート上に配置したActiveXコントロールなので使えず）良い方法がみつからないという意味だったんですね。
流石にもう理解できたとは思いますが、【OLEObjects】を使ったアプローチ自体は[[20230716075008]]で提示されてますよ。
見落としていたならそちらを読み返してみるとよいと思います。
■10
With ws2
If .CommandButton1.Caption = "切替（日付指定）" Then
.年度指定
.日付指定
.曜日取得
.土日行の非表示
ElseIf .CommandButton1.Caption = "切替（年度指定）" Then
.日付指定
.曜日取得
.土日行の非表示
End If
End With
私は普段↑のような記述をしないので、それ自体が記述方法として有効かはわかりかねますが、IF文のところについて「Worksheets("型式.部品情報設定").CommandButton1.Caption」が2パターンしかないのであれば、【ElseIf節】じゃなくて【Else節】のほうが良いようにおもいます。
さらに、「年度指定」以外はどちらでも実行しているので、Thens節は実質１行しかないため↓でよさそうな気がします。
If ws2.CommandButton1.Caption = "切替（日付指定）" Then ws2.年度指定 ws2.日付指定 ws2.曜日取得 ws2.土日行の非表示
■11
さらに、中段部分を抜粋してインデントの付けなおし等をすると↓のようになるわけですが
Sub 抜粋()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i3 As Integer, v As Integer, i2 As Integer
Set ws1 = Worksheets("在庫管理シート")
Set ws2 = Worksheets("型式.部品情報設定")
v = 0
For i3 = 1 To 20
If ws2.OLEObjects("CheckBox" & i3).Object.Value = False Then
ws1.Columns(12).Offset(0, v).Interior.ColorIndex = 15
ws1.Columns(12).Offset(0, v).Offset(0, v).EntireColumn.Hidden = True
Else
ws1.Columns(12).Offset(0, v).Offset(0, v).Interior.ColorIndex = 0
ws1.Columns(12).Offset(0, v).Offset(0, v).EntireColumn.Hidden = False
End If
v = v + 1
Next i3
v = 0
For i2 = 21 To 70
If ws2.OLEObjects("CheckBox" & i2).Object.Value = False Then
ws1.Range("AF:AH").Offset(0, v).Interior.ColorIndex = 15
ws1.Range("AF:AH").Offset(0, v).EntireColumn.Hidden = True
Else
ws1.Range("AF:AH").Offset(0, v).Interior.ColorIndex = 0
ws1.Range("AF:AH").Offset(0, v).EntireColumn.Hidden = False
End If
v = v + 3
Next i2
End Sub
↓のようでもよいように思います。（試してないのでミスっているかもですが）
Sub 整理()
Dim MyOBJ As Object
Dim v As Long
For v = 1 To 70
Set MyOBJ = Worksheets("型式.部品情報設定").OLEObjects("CheckBox" & v).Object
Select Case v
Case 1 To 20
With Worksheets("在庫管理シート").Range("L:L").Offset(, v - 1)
.Interior.ColorIndex = IIf(MyOBJ.Value = False, 15, 0)
.Offset(, v - 1).EntireColumn.Hidden = Not MyOBJ.Value
End With
Case 21 To 70
With Worksheets("在庫管理シート").Range("AF:AH").Offset(, v - 21)
.Interior.ColorIndex = IIf(MyOBJ.Value = False, 15, 0)
.EntireColumn.Hidden = Not MyOBJ.Value
End With
End Select
Next v
End Sub
■12
私には、正直ピンときてませんが「非表示行を作ったのが原因」ならば、単純に該当シートのJ列を対象にFindメソッドを使って逆順検索して【何か入っているセル】の行を調べるのではダメなんでしょうか？
（もこな２） 2023/09/18(月) 10:59:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.