|    | 
     こんにちは。 
IROC さんのコードを拝借して、程よく判りにくくしてみました。(^^;) 
 
Sub sample2() 
  Dim sglResult(4)    As Single 
  Dim ws1 As Worksheet, ws2 As Worksheet 
  Dim i          As Long 
  Dim j          As Long 
  Dim lngMonth     As Long 
 
  'シートをオブジェクト変数に格納 
  Set ws1 = Worksheets("品質会議 実績グラフ") 
  Set ws2 = Worksheets("工作品質会議資料") 
 
  '計算式(小数点第二位切り上げ) 
  With Application.WorksheetFunction 
    For i = 0 To 4 
      sglResult(i) = .RoundUp((ws1.Cells(i + 50, 2) * 1000) / 1000000, 1) 
    Next i 
  End With 
 
  '出力 
  lngMonth = StrConv(Replace(Worksheets(5).Range("I1").Value, "月", ""), vbNarrow) 
  lngMonth = IIf(lngMonth < 4, lngMonth + 12, lngMonth) - 1 
  For i = 0 To 11 
    For j = 0 To 4 
      ws1.Cells(j + 7, lngMonth).Value = sglResult(i) 
      ws1.Cells(13, lngMonth).Value = ws1.Cells(12, lngMonth).Value 
      ws2.Cells(j + 5, lngMonth).Value = sglResult(i) 
      ws2.Cells(11, lngMonth).Value = ws2.Cells(10, lngMonth).Value 
    Next j 
  Next i 
 
  'オブジェクト開放 
  Set ws1 = Nothing 
  Set ws2 = Nothing 
End Sub 
 | 
     
    
   |