EXCEL VBA Array要素記述を変更したい
プログラムの中にセルの値を直接記入しているところがあます。
Select Caseの行の 「Array("101", "102", "103", "104")」のとろです。
プログラムには101, 102, 103, 104ではなくB10～B13を使用したいのですが、うまくできません。
実際には4つだけではなく何十個もあって作業がわずらわしくなるのと、ブックごとに値が異なって
汎用性がないためです。
アドバイスいただけると助かります。
初歩的なことを質問しているかも入れませんが、よろしくお願いいたします。
シート名「表紙」のA列は部品番号（＝シート名）でA10：101 A11：102 A12：103 A13：104とします。
これに対応したシートが4つあり、シート名は、「101」「102」「103」「104」とします。
使用者は「表紙」のシートで下記の作業を行います。
B6セルには製造番号（例：AM01-130012）を入力します。
B10～B13セルは「○」「×」を入力規則から選択します
○を選択した隣のC10～C13セルは部品個数で1～9の数値を入力規則から選択します。
○を選択したのと同じ行のD10～L10、D11～L11、D12～L12、D13～L13セルに、
文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。
下記マクロにて「○」となっているシートのみコピーを作成します。（１）
コピーしたシートすべてのB1セルに製造番号を入力します。（２）
D列に文字列があれば、コピーした対応するシートの中のH3～P3セルへ貼り付けます。（３）
C列の値によって、コピーした対応するシートの中のH3～P3セルの値をクリアします。（４）
＜表紙のシート＞
A B C D E F G H I J K L
5
6 AM01-130012
7
8
9
10 101 × 9
11 102 ○ 3
12 103 ○ 8 A1-1 A1-2 A1-3 A1-4 A1-5 A1-6 A1-7 A1-8
13 104 × 9
＜プログラム＞
Sub TestSample()
Dim c As Range
Dim 製造番号 As String
Dim flg As Boolean
flg = True
With ThisWorkbook
製造番号 = .Worksheets("表紙").Range("B6").Value
For Each c In .Worksheets("表紙").Range("B10:B13")
If c.Value Like "○*" Then
' ' (1)
If flg Then ' 初めてなら、○に対応したシートを「新しいブックにコピー」
.Worksheets(c.Offset(, -1).Text).Copy
flg = False
Else ' それ以外なら、○に対応したシートをアクティブブックの最後にコピー追加
.Worksheets(c.Offset(, -1).Text).Copy After:=Worksheets(Worksheets.Count)
End If
' ' (2)
' ' コピーしたすべてのシート（のB2）に製造番号を書き込む
Range("B1").Value = 製造番号
' ' (3)
' ' ○の行のD:L を 対応するシートのH3:P3 へ貼り付け
If c.Offset(, 2) <> "" Then ' Ｄ列が空でなければ
Range("H3").Value = c.Offset(, 2).Value
Range("I3").Value = c.Offset(, 3).Value
Range("J3").Value = c.Offset(, 4).Value
Range("K3").Value = c.Offset(, 5).Value
Range("L3").Value = c.Offset(, 6).Value
Range("M3").Value = c.Offset(, 7).Value
Range("N3").Value = c.Offset(, 8).Value
Range("O3").Value = c.Offset(, 9).Value
Range("P3").Value = c.Offset(, 10).Value
End If
End If
Next c
End With
' ' (4)
For Each 各シート In Worksheets
With 各シート
.Activate
Select Case ThisWorkbook.Worksheets("表紙").Cells(Application.Match(各シート.Name, Array("101", "102", "103", "104"), 0) + 9, "C").Value
Case "1" '1のときの仕事をする
Range("I3:P3").Select
Selection.ClearContents
Case "2" '2のときの仕事をする
Range("J3:P3").Select
Selection.ClearContents
Case "3" '3のときの仕事をする
Range("K3:P3").Select
Selection.ClearContents
Range("J3").Select
Case "4" '4のときの仕事をする
Range("L3:P3").Select
Selection.ClearContents
Case "5" '5のときの仕事をする
Range("M3:P3").Select
Selection.ClearContents
Case "6" '6のときの仕事をする
Range("N3:P3").Select
Selection.ClearContents
Case "7" '7のときの仕事をする
Range("O3:P3").Select
Selection.ClearContents
Case "8" '8のときの仕事をする
Range("P3").Select
Selection.ClearContents
Case "9" 'do nothing
Case Else
End Select
End With
Next
If flg Then
MsgBox "部品番号が選択されていません。"
Exit Sub
End If
お礼
ありがとうございます。 そのまま、記述すればＯＫなんですね。 難しく考えてました。 早速試してみます。