Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


70168 / 76732 ←次へ | 前へ→

【11075】Re:もっとコンパクトにしたいのですが…
回答  Asaki  - 04/2/27(金) 10:46 -

引用なし
パスワード
   こんにちは。
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

0 hits

【11072】もっとコンパクトにしたいのですが… みぃこ 04/2/27(金) 9:21 質問
【11073】Re:もっとコンパクトにしたいのですが… IROC 04/2/27(金) 10:13 回答
【11075】Re:もっとコンパクトにしたいのですが… Asaki 04/2/27(金) 10:46 回答
【11081】Re:もっとコンパクトにしたいのですが… IROC 04/2/27(金) 13:47 回答
【11095】Re:もっとコンパクトにしたいのですが… Hirofumi 04/2/27(金) 23:20 回答
【11094】Re:もっとコンパクトにしたいのですが… アイエネス 04/2/27(金) 23:17 回答
【11153】Re:驚きました みぃこ 04/3/1(月) 15:26 お礼
【11270】ご報告 みぃこ 04/3/4(木) 14:08 発言
【11271】Re:ご報告 IROC 04/3/4(木) 14:34 回答
【11272】Re:ご報告 みぃこ 04/3/4(木) 14:57 お礼
【11389】Re:ご報告・その2 みぃこ 04/3/8(月) 14:13 お礼

70168 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free