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列から順に入れます。
下記マクロにて「○」となっているシートのみコピーを作成します。(1)
コピーしたシートすべてのB1セルに製造番号を入力します。(2)
D列に文字列があれば、コピーした対応するシートの中のH3~P3セルへ貼り付けます。(3)
C列の値によって、コピーした対応するシートの中のH3~P3セルの値をクリアします。(4)
<表紙のシート>
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 ' D列が空でなければ
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
お礼
解決しました 説明までつけていただきありがとうございました