Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12277 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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:ご報告・その２ みぃこ 04/3/8(月) 14:13 お礼
【11072】もっとコンパクトにしたいのですが…
質問  みぃこ E-MAIL  - 04/2/27(金) 9:21 -
引用なし
パスワード
   アイエネスさん、range指定の仕方までご教授して下さって、ありがとうございます。おかげさまで、思うような結果が得られました。

今回の質問ですが、select caseの処理の書き方についてです。当月分の集計明細シートからグラフ作成用の別シートの所定の位置へ値を出力させる処理を作りたいと思っています。とりあえず、こんな感じでコードを書いてみました。

Dim 資材 As Single
Dim 工作 As Single
Dim 設計 As Single
Dim 生産設計 As Single
Dim その他 As Single

'計算式（小数点第二位切り上げ）
資材 = Application.WorksheetFunction.RoundUp((Sheets("品質会議　実績グラフ").Range("B50") * 1000) / 1000000, 1)
工作 = Application.WorksheetFunction.RoundUp((Sheets("品質会議　実績グラフ").Range("B51") * 1000) / 1000000, 1)
設計 = Application.WorksheetFunction.RoundUp((Sheets("品質会議　実績グラフ").Range("B52") * 1000) / 1000000, 1)
生産設計 = Application.WorksheetFunction.RoundUp((Sheets("品質会議　実績グラフ").Range("B53") * 1000) / 1000000, 1)
その他 = Application.WorksheetFunction.RoundUp((Sheets("品質会議　実績グラフ").Range("B54") * 1000) / 1000000, 1)

'出力
Select Case Worksheets(5).Range("I1")

Case "４月"
　　 Sheets("品質会議　実績グラフ").Range("C7").Value = 資材
　　 Sheets("品質会議　実績グラフ").Range("C8").Value = 工作
　　 Sheets("品質会議　実績グラフ").Range("C9").Value = 設計
　　 Sheets("品質会議　実績グラフ").Range("C10").Value = 生産設計
　　 Sheets("品質会議　実績グラフ").Range("C11").Value = その他
　　 Sheets("品質会議　実績グラフ").Range("C13").Value = Sheets("品質会議　実績グラフ").Range("C12")
　　
　　 Sheets("工作品質会議資料").Range("C5").Value = 資材
　　 Sheets("工作品質会議資料").Range("C6").Value = 工作
　　 Sheets("工作品質会議資料").Range("C7").Value = 設計
　　 Sheets("工作品質会議資料").Range("C8").Value = 生産設計
　　 Sheets("工作品質会議資料").Range("C9").Value = その他
　　 Sheets("工作品質会議資料").Range("C11").Value = Sheets("工作品質会議資料").Range("C10")
　　

Case "５月"
　　 Sheets("品質会議　実績グラフ").Range("D7").Value = 資材
　　 Sheets("品質会議　実績グラフ").Range("D8").Value = 工作
　　 Sheets("品質会議　実績グラフ").Range("D9").Value = 設計
　　 Sheets("品質会議　実績グラフ").Range("D10").Value = 生産設計
　　 Sheets("品質会議　実績グラフ").Range("D11").Value = その他
　　 Sheets("品質会議　実績グラフ").Range("D13").Value = Sheets("品質会議　実績グラフ").Range("C13").Value + Sheets("品質会議　実績グラフ").Range("D12").Value
　　
　　 Sheets("工作品質会議資料").Range("D5").Value = 資材
　　 Sheets("工作品質会議資料").Range("D6").Value = 工作
　　 Sheets("工作品質会議資料").Range("D7").Value = 設計
　　 Sheets("工作品質会議資料").Range("D8").Value = 生産設計
　　 Sheets("工作品質会議資料").Range("D9").Value = その他
　　 Sheets("工作品質会議資料").Range("D11").Value = Sheets("工作品質会議資料").Range("C11").Value + Sheets("工作品質会議資料").Range("D10").Value
　　
・
・
・
以下翌３月分まで

思うように動いてはくれるのですが、かなり長くなるので、後々に分かりづらいように思います。出力先が隣のセルに移っていくだけで、内容は同じですので、もっと短い記述で済むような方法はあるのでしょうか？ぜひご教示ください。
【11073】Re:もっとコンパクトにしたいのですが…
回答  IROC  - 04/2/27(金) 10:13 -
引用なし
パスワード
   ひとまず、With文　と　オブジェクト変数(Worksheet)を使ってみました。

Sub sample()
Dim 資材 As Single, 工作 As Single, 設計 As Single
Dim 生産設計 As Single, その他 As Single
Dim ws1 As Worksheet, ws2 As Worksheet

　　'シートをオブジェクト変数に格納
　　Set ws1 = Worksheets("品質会議　実績グラフ")
　　Set ws2 = Worksheets("工作品質会議資料")
　　　　
　　'計算式（小数点第二位切り上げ）
　　With Application.WorksheetFunction
　　　　資材 = .RoundUp((ws1.Range("B50") * 1000) / 1000000, 1)
　　　　工作 = .RoundUp((ws1.Range("B51") * 1000) / 1000000, 1)
　　　　設計 = .RoundUp((ws1.Range("B52") * 1000) / 1000000, 1)
　　　　生産設計 = .RoundUp((ws1.Range("B53") * 1000) / 1000000, 1)
　　　　その他 = .RoundUp((ws1.Range("B54") * 1000) / 1000000, 1)
　　End With
　

　　'出力
　　Select Case Worksheets(5).Range("I1").Value
　　
　　Case "４月"
　　　　With ws1
　　　　　　.Range("C7").Value = 資材
　　　　　　.Range("C8").Value = 工作
　　　　　　.Range("C9").Value = 設計
　　　　　　.Range("C10").Value = 生産設計
　　　　　　.Range("C11").Value = その他
　　　　　　.Range("C13").Value = Sheets("品質会議　実績グラフ").Range("C12").Value
　　　　End With
　　　
　　　　With ws2
　　　　　　.Range("C5").Value = 資材
　　　　　　.Range("C6").Value = 工作
　　　　　　.Range("C7").Value = 設計
　　　　　　.Range("C8").Value = 生産設計
　　　　　　.Range("C9").Value = その他
　　　　　　.Range("C11").Value = Sheets("工作品質会議資料").Range("C10").Value
　　　　End With
　　
　　Case "５月"
　　　　With ws1
　　　　　　.Range("D7").Value = 資材
　　　　　　.Range("D8").Value = 工作
　　　　　　.Range("D9").Value = 設計
　　　　　　.Range("D10").Value = 生産設計
　　　　　　.Range("D11").Value = その他
　　　　　　.Range("D13").Value = .Range("C13").Value + .Range("D12").Value
　　　　End With
　　　
　　　　With ws2
　　　　　　.Range("D5").Value = 資材
　　　　　　.Range("D6").Value = 工作
　　　　　　.Range("D7").Value = 設計
　　　　　　.Range("D8").Value = 生産設計
　　　　　　.Range("D9").Value = その他
　　　　　　.Range("D11").Value = .Range("C11").Value + .Range("D10").Value
　　　　End With

End Sub
【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
【11081】Re:もっとコンパクトにしたいのですが…
回答  IROC  - 04/2/27(金) 13:47 -
引用なし
パスワード
   Offset関数で、列方向に　月数−４ 移動するようにしてみました。

Sub sample()
Dim 資材 As Single, 工作 As Single, 設計 As Single
Dim 生産設計 As Single, その他 As Single
Dim ws1 As Worksheet, ws2 As Worksheet
Dim mycol As Long

　　'シートをオブジェクト変数に格納
　　Set ws1 = Worksheets("品質会議　実績グラフ")
　　Set ws2 = Worksheets("工作品質会議資料")
　　
　　'計算式（小数点第二位切り上げ）
　　With Application.WorksheetFunction
　　　　資材 = .RoundUp((ws1.Range("B50") * 1000) / 1000000, 1)
　　　　工作 = .RoundUp((ws1.Range("B51") * 1000) / 1000000, 1)
　　　　設計 = .RoundUp((ws1.Range("B52") * 1000) / 1000000, 1)
　　　　生産設計 = .RoundUp((ws1.Range("B53") * 1000) / 1000000, 1)
　　　　その他 = .RoundUp((ws1.Range("B54") * 1000) / 1000000, 1)
　　End With

　　
　　mycol = CLng(Left(Worksheets(5).Range("I1").Value, _
　　　　　　Len(Worksheets(5).Range("I1").Value - 1)))
　　
　　　　With ws1
　　　　　　.Cells(7, 3).Offset(0, mycol - 4).Value = 資材
　　　　　　.Cells(8, 3).Offset(0, mycol - 4).Value = 工作
　　　　　　.Cells(9, 3).Offset(0, mycol - 4).Value = 設計
　　　　　　.Cells(10, 3).Offset(0, mycol - 4).Value = 生産設計
　　　　　　.Cells(11, 3).Offset(0, mycol - 4).Value = その他
　　　　　　.Cells(13, 3).Offset(0, mycol - 4).Value = .Range("C12").Value
　　　　End With
　　
　　　　With ws2
　　　　　　.Cells(5, 3).Offset(0, mycol - 4).Value = 資材
　　　　　　.Cells(6, 3).Offset(0, mycol - 4).Value = 工作
　　　　　　.Cells(7, 3).Offset(0, mycol - 4).Value = 設計
　　　　　　.Cells(8, 3).Offset(0, mycol - 4).Value = 生産設計
　　　　　　.Cells(9, 3).Offset(0, mycol - 4).Value = その他
　　　　　　.Cells(11, 3).Offset(0, mycol - 4).Value = .Range("C10").Value
　　　　End With

End Sub
【11094】Re:もっとコンパクトにしたいのですが…
回答  アイエネス  - 04/2/27(金) 23:17 -
引用なし
パスワード
   こんにちは　

みなさんのコードを参考にして作ってみました。

Sub test()
Dim i As Long
Dim j As Long
Dim mj As Single
Dim mk As Single
Dim suuti(4) As Single
Dim tuki As Long
Dim 実績グラフ As Worksheet
Dim 会議資料 As Worksheet
Set 実績グラフ = Worksheets("品質会議　実績グラフ")
Set 会議資料 = Worksheets("工作品質会議資料")

Application.ScreenUpdating = False
'計算式 (小数点第二位切り上げ)
For i = 0 To 4
suuti(i) = Application.WorksheetFunction.RoundUp((実績グラフ.Cells(50 + i, 2) * 1000) / 1000000, 1)
Next i

'出力
tuki = Replace(Worksheets(5).Range("I1").Value, "月", "")
j = IIf(tuki < 4, tuki + 11, tuki - 1)
For i = 0 To 4
実績グラフ.Cells(7 + i, j) = suuti(i)
会議資料.Cells(5 + i, j) = suuti(i)
Next i
If j = 3 Then
mj = 0
mk = 0
Else
mj = 実績グラフ.Cells(13, j - 1)
mk = 会議資料.Cells(11, j - 1)
End If
実績グラフ.Cells(13, j) = 実績グラフ.Cells(12, j) + mj
会議資料.Cells(11, j) = 会議資料.Cells(10, j) + mk
Application.ScreenUpdating = True
Set 実績グラフ = Nothing
Set 会議資料 = Nothing
End Sub

ちなみに、「品質会議 実績グラフ」シートの13行目、「工作品質会議資料」シートの11行目には、前月の13行目、11行目と当月の１2行目、10行目の合計が入るのでしょうか？それとも、4月から当月までの12行目、10行目の合計が入るのでしょうか？それによって少し変わります。
【11095】Re:もっとコンパクトにしたいのですが…
回答  Hirofumi E-MAIL  - 04/2/27(金) 23:20 -
引用なし
パスワード
   思いっきりやるとこんなかな？
上手く行かなかったらゴメン

Public Sub Sample()

　　Dim i As Long
　　Dim vntData As Variant
　　'vntData(1, 1) : 資材
　　'vntData(2, 1) : 工作
　　'vntData(3, 1) : 設計
　　'vntData(4, 1) : 生産設計
　　'vntData(5, 1) : その他
　　Dim lngMonth As Long
　　Dim vntSheets As Variant
　　
　　vntSheets = Array("工作品質会議資料", "品質会議　実績グラフ")
　　
　　'計算式（小数点第二位切り上げ）
　　With Sheets(vntSheets(1))
　　　　vntData = .Range("B50:B54").Value
　　　　For i = 1 To 5
　　　　　　vntData(i, 1) = -Int(-vntData(i, 1) / 100) / 10
　　　　Next i
　　End With
　　
　　'出力
　　lngMonth = Val(StrConv(Worksheets(5).Range("I1"), vbNarrow))
　　lngMonth = ((lngMonth + 8) Mod 12) + 3
　　For i = 0 To 1
　　　　With Sheets(vntSheets(i))
　　　　　　Range(.Cells(5 + 2 * i, lngMonth), _
　　　　　　　　　　.Cells(5 + 2 * i, lngMonth)).Value = vntData
　　　　　　.Cells(11 + 2 * i, lngMonth).Value _
　　　　　　　　　　　　= .Cells(10 + 2 * i, lngMonth).Value
　　　　　　If lngMonth > 0 Then
　　　　　　　　.Cells(11 + 2 * i, lngMonth).Value _
　　　　　　　　　　= .Cells(11 + 2 * i, lngMonth).Value _
　　　　　　　　　　　　+ .Cells(11 + 2 * i, lngMonth - 1).Value
　　　　　　End If
　　　　End With
　　Next i

End Sub
【11153】Re:驚きました
お礼  みぃこ E-MAIL  - 04/3/1(月) 15:26 -
引用なし
パスワード
   みなさん、ご教授ありがとうございました。色々な記述方法があるのですね！あの長かったコードが、随分短くなったので驚きました。ただ、入門者レベルの私には、今ひとつ何が書いてあるのか理解しきれていませんが(汗)。ゆっくり勉強させていただきます。
今日は少々忙しくてまだ試せていませんが、手が空いたら、早速試してみます。まずはお礼まで。


アイエネスさまへ
>
>ちなみに、「品質会議 実績グラフ」シートの13行目、「工作品質会議資料」シートの11行目には、前月の13行目、11行目と当月の１2行目、10行目の合計が入るのでしょうか？それとも、4月から当月までの12行目、10行目の合計が入るのでしょうか？それによって少し変わります。


「品質会議　実績グラフ」シート、「工作品質会議資料」とも、累計が入ります。前月累計（４月は当月合計）＋当月合計です。「品質〜」は12行目、「工作〜」は10行目が当月合計で、ここにはsum関数が入っています。
【11270】ご報告
発言  みぃこ E-MAIL  - 04/3/4(木) 14:08 -
引用なし
パスワード
   ようやく試してみることができたので、ご報告します。

IROCさまへ
グラフ用の表の所定の位置に数値が入りましたが、Worksheets(5).Range("I1")の値が数値でないとだめでした。ここは全角で「○月」と入ります。それと、「品質会議〜」シートの13行目と「工作品質〜」シートの11行目は累計が入っていきますが、当月合計になりました。説明不足で申し訳ありません。

Asakiさまへ
資材〜その他まで、すべて同じ値が入ったところで「インデックスが有効範囲にありません」メッセージが出ました（コードのタイプミスがないか見直してみましたが、タイプミスはありませんでした）。

Hirofumiさまへ
12月の資材のところにだけ数値が入りました。

アイエネスさまへ
「工作品質〜」シートの方の累計が入りませんでした。


みなさんのコードを参考にさせていただいて、頑張ってみます。ご教授有り難うございました
【11271】Re:ご報告
回答  IROC  - 04/3/4(木) 14:34 -
引用なし
パスワード
   >グラフ用の表の所定の位置に数値が入りましたが、
>Worksheets(5).Range("I1")の値が数値でないとだめでした。
>ここは全角で「○月」と入ります。

mycol = CLng(Left(Worksheets(5).Range("I1").Value, _
　　　　　　Len(Worksheets(5).Range("I1").Value)-1))

に変更してみて下さい。
【11272】Re:ご報告
お礼  みぃこ E-MAIL  - 04/3/4(木) 14:57 -
引用なし
パスワード
   変更してみたところ、入りました。早速のご回答、有り難うございます。


アイエネスさまへ
ケチをつけてしまいましたが、私のタイプミスでした。大変失礼いたしました、お許しください。
【11389】Re:ご報告・その２
お礼  みぃこ E-MAIL  - 04/3/8(月) 14:13 -
引用なし
パスワード
   実は助けていただいた箇所は長い記述の一部で、似たような記述をしていたところが後2ヶ所ほどあったのですが、皆さんにご教授いただいたコードの真似をして手直ししてみたところ、およそ400行、短くすることができました。
おかげさまでかなりスッキリしましたし、大変勉強になりました。ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12277 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free