VBA ステートメントをまとめたい

質問

OSはXP
Excelは2003を使用しています。

下記は組んだマクロの一部ですが、
ComboBoxが20まであるので、大変長いステートメントになってしまうので、
withの中を何とかまとめられないかと思い、こちらで教えて頂きたく書き込みました。

説明不足のところは追記致しますので、
何卒、よろしくお願い致します。

With ws 'Cells(行,列)
　If ComboBox1 <> "" Then
Cells(i + 1, 1) = TextBox1.Value '日付
Cells(i + 1, 2) = TextBox2.Value '伝票No.
Cells(i + 1, 24) = TextBox3.Value '郵便番号
Cells(i + 1, 25) = TextBox4.Value '住所
Cells(i + 1, 3) = TextBox5.Value '社名
Cells(i + 1, 4) = TextBox6.Value '担当者名
Cells(i + 1, 18) = TextBox601.Value '税抜合計
Cells(i + 1, 19) = TextBox602.Value '消費税
Cells(i + 1, 20) = TextBox603.Value '合計
Cells(i + 1, 22) = TextBox701.Value '備考
Cells(i + 1, 23) = TextBox702.Value '未定
'------------------------------------------------------
Cells(i + 1, 6) = ComboBox1.Value '商品コード
Cells(i + 1, 7) = TextBox11.Value 'メーカー名
Cells(i + 1, 8) = TextBox12.Value 'ModelNo.
Cells(i + 1, 9) = TextBox13.Value '品名(英
Cells(i + 1, 10) = TextBox14.Value '品名(日
Cells(i + 1, 11) = TextBox15.Value '仕上(英
Cells(i + 1, 12) = TextBox16.Value '仕上(日
Cells(i + 1, 13) = TextBox17.Value '単価
Cells(i + 1, 14) = TextBox18.Value '掛け率
Cells(i + 1, 15) = TextBox19.Value '売価
Cells(i + 1, 16) = TextBox20.Value '数量
Cells(i + 1, 17) = TextBox21.Value '小計
Cells(i + 1, 21) = TextBox22.Value '社内コメント
'----------------------------------------------------
'----------------------------------------------------
If ComboBox2 <> "" Then
Cells(i + 2, 1) = TextBox1.Value '日付
Cells(i + 2, 2) = TextBox2.Value '伝票No.
Cells(i + 2, 24) = TextBox3.Value '郵便番号
Cells(i + 2, 25) = TextBox4.Value '住所
Cells(i + 2, 3) = TextBox5.Value '社名
Cells(i + 2, 4) = TextBox6.Value '担当者名
Cells(i + 2, 18) = TextBox601.Value '税抜合計
Cells(i + 2, 19) = TextBox602.Value '消費税
Cells(i + 2, 20) = TextBox603.Value '合計
Cells(i + 2, 22) = TextBox701.Value '備考
Cells(i + 2, 23) = TextBox702.Value '未定
'------------------------------------------------------
Cells(i + 2, 6) = ComboBox2.Value '商品コード
Cells(i + 2, 7) = TextBox31.Value 'メーカー名
Cells(i + 2, 8) = TextBox32.Value 'ModelNo.
Cells(i + 2, 9) = TextBox33.Value '品名(英
Cells(i + 2, 10) = TextBox34.Value '品名(日
Cells(i + 2, 11) = TextBox35.Value '仕上(英
Cells(i + 2, 12) = TextBox36.Value '仕上(日
Cells(i + 2, 13) = TextBox37.Value '単価
Cells(i + 2, 14) = TextBox38.Value '掛け率
Cells(i + 2, 15) = TextBox39.Value '売価
Cells(i + 2, 16) = TextBox40.Value '数量
Cells(i + 2, 17) = TextBox41.Value '小計
Cells(i + 2, 21) = TextBox42.Value '社内コメント
End If
End If

回答No.1

mar00 · ベストアンサー

日付から未定まではテキストボックスがバラバラなので、セルだけ共通にしています。
For j = 1 To 2
If Controls("ComboBox" & j) <> "" Then
If j = 1 Then
myNumber = 10
ElseIf j = 2 Then
myNumber = 30
End If
.Cells(i + j, 1) = TextBox1.Value '日付
.Cells(i + j, 2) = TextBox2.Value '伝票No.
.Cells(i + j, 24) = TextBox3.Value '郵便番号
.Cells(i + j, 25) = TextBox4.Value '住所
.Cells(i + j, 3) = TextBox5.Value '社名
.Cells(i + j, 4) = TextBox6.Value '担当者名
.Cells(i + j, 18) = TextBox601.Value '税抜合計
.Cells(i + j, 19) = TextBox602.Value '消費税
.Cells(i + j, 20) = TextBox603.Value '合計
.Cells(i + j, 22) = TextBox701.Value '備考
.Cells(i + j, 23) = TextBox702.Value '未定
.Cells(i + j, 6) = Controls("ComboBox" & j).Value '商品コード

For k = 1 To 12
If k < 12 Then
.Cells(i + j, k + 6) = Controls("TextBox" & k + myNumber).Value 'メーカー名から小計
Else
.Cells(i + j, k + 9) = Controls("TextBox" & k + myNumber).Value '社内コメント
End If
Next k
End If
Next j
動作確認はしていませんのでブックをコピーするなどしてから確認して下さい。

お礼

確認が遅くなってしまってごめんなさい。

書いて下さったステートメントで、まとめる前と同じ様に出来ました。
これをComboBox20まで対応させれば、すごくステートメントがまとめられるし、見やすくなります。

本当にありがとうございました。

回答No.2

mitarashi

ワークシートに対照表を作成しておいて、フォーム生成の際に読み込むのはいかがでしょうか。手直しが楽だと思います。
書き出し時に、ワークシートを読みに行っても良いのですが、思いつきで構造体に取り込んでみました。
対照表は添付画像の様な姿で、起点セルからのオフセットを入れておきます。（あくまで例なので、ご質問のセル配置とは異なっています）

Private Type controlInfo
controlName As String
rowOffset As Long
columnOffset As Long
End Type

Dim myControls() As controlInfo

Private Sub UserForm_Initialize()
Dim controlInfoRange As Range
Dim i As Long

Set controlInfoRange = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion
ReDim myControls(1 To controlInfoRange.Rows.Count)
For i = 1 To UBound(myControls)
With myControls(i)
.controlName = controlInfoRange(i, 1)
.rowOffset = controlInfoRange(i, 2)
.columnOffset = controlInfoRange(i, 3)
End With
Next i
End Sub

Private Sub CommandButton1_Click()
Dim sh As Worksheet, myRange As Range
Dim i As Long

Set sh = ThisWorkbook.Worksheets(2)
Set myRange = sh.Range("A1")
For i = 1 To UBound(myControls)
With myControls(i)
myRange.Offset(.rowOffset, .columnOffset).Value = Me.Controls(.controlName).Value
End With
Next i
Unload Me
End Sub

☆下記はおまけ。標準モジュールに記述してください。
フォームのコントロールの名前のリストをワークシートに出力します。

Sub test()
Dim myControl As Control
Dim destRange As Range

Set destRange = ThisWorkbook.Worksheets(1).Range("A1")
Load UserForm1
For Each myControl In UserForm1.Controls
destRange.Value = myControl.Name
Set destRange = destRange.Offset(1, 0)
Next myControl
Unload UserForm1
End Sub

お礼

mitarashiさんの書いて下さったステートメントを自分のに置き換えてみようとしたのですが、今まで使ったことのないものばかりで、うまく置き換える事が出来ませんでした。
もう少し考えて置き換えてみます。ごめんなさい。

おまけで書いて下さった標準モジュールの方、すごく有り難いです。
手書きで書き出してたので、これが出来ると手間がかなり省けます。
本当にありがとうございました。