上図にある比較DATA数という所に比較したい数をいれてマクロを実行するとB2~B6までの各シートができるというものなんですが、Select Caseを使用してる為、コードがすごく長いです。
なので下記コードを短縮できないか知りたいです。
お手数ですがアドバイスをお願いしたいです。
よろしくお願い致します。
Sub Graph() Dim op As Worksheet, i As Long Dim cPath As String, ShNo As String Set op = Workbooks("CAB-Grapf.xls").ActiveSheet cPath = op.Range("B1").Value Application.ScreenUpdating = False 'シートを追加 Worksheets.Add After:=Sheets("DATA"), Count:=op.Range("K1").Value Select Case op.Range("K1").Value Case 1 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Case 2 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Case 3 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Case 4 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Case 5 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Case 6 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Sheets("sheet6").Select ActiveSheet.Name = op.Range("B7").Value Case 7 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Sheets("sheet6").Select ActiveSheet.Name = op.Range("B7").Value Sheets("sheet7").Select ActiveSheet.Name = op.Range("B8").Value Case 8 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Sheets("sheet6").Select ActiveSheet.Name = op.Range("B7").Value Sheets("sheet7").Select ActiveSheet.Name = op.Range("B8").Value Sheets("sheet8").Select ActiveSheet.Name = op.Range("B9").Value Case 9 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Sheets("sheet6").Select ActiveSheet.Name = op.Range("B7").Value Sheets("sheet7").Select ActiveSheet.Name = op.Range("B8").Value Sheets("sheet8").Select ActiveSheet.Name = op.Range("B9").Value Sheets("sheet9").Select ActiveSheet.Name = op.Range("B10").Value Case 10 Sheets("sheet1").Select ActiveSheet.Name = op.Range("B2").Value Sheets("sheet2").Select ActiveSheet.Name = op.Range("B3").Value Sheets("sheet3").Select ActiveSheet.Name = op.Range("B4").Value Sheets("sheet4").Select ActiveSheet.Name = op.Range("B5").Value Sheets("sheet5").Select ActiveSheet.Name = op.Range("B6").Value Sheets("sheet6").Select ActiveSheet.Name = op.Range("B7").Value Sheets("sheet7").Select ActiveSheet.Name = op.Range("B8").Value Sheets("sheet8").Select ActiveSheet.Name = op.Range("B9").Value Sheets("sheet9").Select ActiveSheet.Name = op.Range("B10").Value Sheets("sheet10").Select ActiveSheet.Name = op.Range("B11").Value Case Else MsgBox "シートが追加されていません。" End Select End Sub
回答3件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/01/24 11:50
2017/01/25 00:26