Excel VBA,ﾕｰｻﾞｰﾌｫｰﾑ内checkboxの判定保持を各行で行いたいです

前提・実現したいこと

別のサイトでご教示いただいた記述を参考に、自分のやりたいことを盛り込んでみたのですが
思うようにいかず、また動作も遅いように感じるのでご指摘をいただけたら幸いです。

前提

3行目から各行にそれぞれフォームコントロールボタンが挿入されており、
同じマクロが登録されています。
(下表E3のボタンをコピーして各行に貼り付け)

【入力用シート】

	A	B	C	D
2	日付	概要	対象製品
3	1月1日	特価セール開始	(りんご)(いちご)(みかん)	【ボタン】
4	1月2日	追加発注	(りんご)(いちご)	【ボタン】
5			【ボタン】

各ボタンに登録されているマクロ(標準モジュール)

Sub 呼び出し()
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -1).Value _
        = UserForm1.GetData
 End Sub

ボタンからユーザーフォームを呼び出し、C列に入力された概要の対称となる製品を
ユーザーフォームにあるチェックボタン(170個)でチェックしD列に()付きで入力するという
動きをさせています。
この時判定用シートへチェック内容を落とし込み、2回目のボタン押下時もそれを読み取ることで
チェックが残っている状態になる(同じ内容でチェックし直されている)ようにしています。
.
ユーザーフォームの記述(フォームモジュール)

 Option Explicit
 Private data As String
 Private Sub UserForm_Initialize()

  Dim i As Integer
      For i = 1 To 170 'checkbox総数170
      
    Controls("CheckBox" & i).Value = (Worksheets("判定用シート").Cells(3, i + 3).Value)
   
    Controls("CheckBox" & i).Caption = Worksheets("製品管理シート").Cells(i + 2, 520).Value
    '520はcheckboxのCaptionに設定したい名前(りんご、いちご等)を並べた列SZの列番号
    
    Next i

 End Sub
 
 Private Sub CommandButton1_Click()

 Dim ctl As MSForms.Control
    Dim buf As String
    For Each ctl In Me.Controls
        If ctl.Name Like "CheckBox*" And ctl.Value = True Then
            buf = buf & "(" & ctl.Caption & ")"
        End If
    Next
    data = buf
    Me.Hide

 End Sub
 Public Function GetData() As String
    Me.Show vbModal
    GetData = data
    Unload Me
 End Function
Private Sub UserForm_Terminate()
 Dim i As Integer
      For i = 1 To 170 'checkbox総数170
      
Worksheets("判定用シート").Cells(3, i + 3).Value = Controls("CheckBox" & i).Value
 Next i
 
End Sub

【判定用シート】
2列目にはCbx1から170まで、製品管理シートを参照した製品名が入っています。
C列には入力用シートを参照した概要が入っています。
D3から右下に広がる表の倫理値は、初期値FALSE、ユーザーフォームからチェックを入れると
対応する箇所にTRUEが入ります。

(…や：は行間・列間を省略しているものとお考え下さい)
||B|C|D|E|F|G|...|FQ|||
|:--:|:--:|:--:|:--:|:--:|:--:|:--:|:--:|:--:|:--:|
|2||||りんご|いちご|ぶどう|みかん|...|Cbx170|←"製品管理ｼｰﾄ"転記
|3||1月1日|特価セール開始|TRUE|TRUE|FALSE|TRUE|...|FALSE|←倫理値手入力
|4||1月2日|追加発注|TRUE|TRUE|FALSE|FALSE|...|FALSE|←倫理値手入力
|：||：|：|：|：|：|：|：|：|
|200||↑"入力用ｼｰﾄ"転記|↑"入力用ｼｰﾄ"転記|FALSE|FALSE|FALSE|FALSE|...|FALSE|←倫理値手入力

発生している問題・エラーメッセージ

【入力用シート】ユーザーフォームにてチェックした製品を左隣のセルに()付きで入力、

同じ箇所のボタンを2回目以降押す場合にもチェックを維持させたい(再チェックの手間を省きたい)

【製品管理シート】から拾ってきた製品名をそのまま各チェックボックスのCaptionとしたい

といった内容で動かしたく、前提のマクロ記述でなんとなく動かせてはいるのですが、
以下2点の問題が生じており、解決方法がわかりません。

【入力用シート】2行目以降のボタンが全て1行目のチェック内容を反映してしまう
ユーザーフォーム内コマンドボタンを押す・×で閉じる、いずれも少し遅い(5~10秒程度)

試したこと

【入力用シート】2行目以降のボタンが全て1行目のチェック内容を反映してしまう

→ループの記述に間違いがあるのかと、
Controls("CheckBox" & i).Value = (Worksheets("判定用シート").Cells(3, i + 3).Value)
部分を
Controls("CheckBox" & 1).Value = (Worksheets("判定用シート").Cells(3, 4).Value)
Controls("CheckBox" & 2).Value = (Worksheets("判定用シート").Cells(3, 5).Value)
：
というように10個ほどまで記述したらうまくそれぞれのボタンで反映してくれました。
が、170個全てを記述するのは現実的でなく、うまくループする記述も見つけられませんでした。

ユーザーフォーム内コマンドボタンを押す・×で閉じる、いずれも少し遅い(5~10秒程度)

→Application.ScreenUpdating や Application.Calculation を各工程に組み込みましたが
速度はほとんど変わりませんでした。5~10秒が妥当でやむを得ない時間なのであれば諦めますが、その判断も出来兼ねています。

EXCEL2019、Windows10を使用しています。
VBA初心者で、変数等の理解も未だ出来ておりません。インターネットから拾ったものを自分のシートのセルに当てはめるのも精一杯で、上記の出来上がっている記述も別サイトにて教えていただいたものです。
(教えていただいた時点ではループ処理やチェック保持等はお伝えしていませんでした)

それを自分なりに改造してしまったのでうまく動作していないのかと思いますが、どういう風に直せば理想の動きに出来るのか、ご教示いただければ幸いです。
よろしくお願いします。

以下、参考までに別サイトで教えていただいた記述を置かせていただきます。(セル参照は異なります)

  (フォームモジュール)
 Option Explicit
 Private data As String
 Private Sub UserForm_Initialize()
    Me.CheckBox1.Caption = Worksheets("製品管理シート").Range("B1").Value
    Me.CheckBox2.Caption = Worksheets("製品管理シート").Range("B2").Value
    Me.CheckBox3.Caption = Worksheets("製品管理シート").Range("B3").Value
 End Sub
 Private Sub CommandButton1_Click()
    Dim ctl As MSForms.Control
    Dim buf As String
    For Each ctl In Me.Controls
        If ctl.Name Like "CheckBox*" And ctl.Value = True Then
            buf = buf & ctl.Caption
        End If
    Next
    data = buf
    Me.Hide
 End Sub
 Public Function GetData() As String
    Me.Show vbModal
    GetData = data
    Unload Me
 End Function

 (標準モジュール)
 Sub 呼び出し()
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -1).Value _
        = UserForm1.GetData
 End Sub

hatena19

2021/12/13 03:33

各チェックボックスのキャプションを "製品管理シート" から設定してますが、"判定用シート"の2行目と同じもののように見えますが、それではダメですか。【入力用シート】のB列、C列と【判定用シート】のB列、C列は同じデータのようですが、これは保証されてますか。

wsy

2021/12/13 03:58

お返事をありがとうございます。 "判定用シート"の2行目は、"製品管理シート" を参照しております。キャプション設定は問題なく出来ておりますが、他の記述と何か絡んで変な改造をしてしまっているかもしれないと思い、敢えてやりたい事として書かせていただきました。【判定用シート】の内容は全て【製品管理シート】または【入力用シート】からの転記 (=製品管理シート!$SZ$3等)となっているので、常に同じデータになると思います。【判定用シート】は倫理値のみ手入力してあり、マクロが完成し次第非表示にする予定です。よろしくお願いいたしします。

行動規範の内容に同意します

回答1件

ベストアンサー

リスト【入力用シート】2行目以降のボタンが全て1行目のチェック内容を反映してしまう

Worksheets("判定用シート").Cells(3, i + 3).Valueというように3行目で固定しているのが原因ですね。
GetDataの引数でクリックしたボタンの行数を渡すようにすればいいでしょう。

vba
1Public Function GetData(RowNum As Long) As String

vba
1Sub 呼び出し()
2    With ActiveSheet.Shapes(Application.Caller).TopLeftCell
3        .Offset(, -1).Value = UserForm1.GetData(.Row)
4    End With
5End Sub

ユーザーフォーム内コマンドボタンを押す・×で閉じる、いずれも少し遅い(5~10秒程度)

170回のループ、セルの代入ぐらいでそれだけ時間がかかるのはちょっと考えられないような気がします。

Application.ScreenUpdating や Application.Calculation を各工程に組み込みましたが

これがうまく組み込まれていないような気がします。

とりあえず、上記の点を考慮して修正してみましたので、下記で試してみてください。

vba
1Option Explicit
2Private data As String
3Private r As Long
4
5Private Sub CommandButton1_Click()
6    Dim buf As String
7    Dim i As Long
8    For i = 1 To 170    'checkbox総数170
9        With Controls("CheckBox" & i)
10            If .Value = True Then
11                buf = buf & "(" & .Caption & ")"
12            End If
13            Worksheets("判定用シート").Cells(r, i + 3).Value = .Value
14        End With
15    Next i
16
17    data = buf
18    Me.Hide
19End Sub
20
21Public Function GetData(RowNum As Long) As String
22    Application.ScreenUpdating = False
23    Application.Calculation = xlCalculationManual
24
25    r = RowNum
26    With Worksheets("判定用シート")
27        Dim i As Integer
28        For i = 1 To 170    'checkbox総数170
29
30            Controls("CheckBox" & i).Value = (.Cells(r, i + 3).Value)
31            Controls("CheckBox" & i).Caption = (.Cells(2, i + 3).Value)
32            '判定用シートの2行目は"製品管理シートからの転記ということなので判定用シートのみの参照に変更
33        Next i
34    End With
35
36    Me.Show vbModal
37    GetData = data
38    Unload Me
39
40    Application.ScreenUpdating = True
41    Application.Calculation = xlCalculationAutomatic
42End Function

投稿2021/12/13 05:18

hatena19

総合スコア33795

wsy

2021/12/13 06:29

早速の詳細なご回答をありがとうございます。希望通りの動きになり、処理時間もほぼ0になってくれました。 Worksheets("判定用シート").Cells(3, i + 3).Value　の行指定も変数に置き換えないとそりゃずっと同じところ反映するよな…と、言われて初めて気が付きました。お恥ずかしい限りです。自分で初めて変数を使ってみたのですが、大変勉強になりました。本当にありがとうございました。

行動規範の内容に同意します