Excel VBA質問箱 IV

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

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


3567 / 13646 ツリー ←次へ | 前へ→

【61398】同じ処理の簡略化 たけ 09/5/5(火) 23:07 質問[未読]
【61401】Re:同じ処理の簡略化 neptune 09/5/5(火) 23:42 発言[未読]
【61403】Re:同じ処理の簡略化 たけ 09/5/6(水) 0:38 発言[未読]
【61405】Re:同じ処理の簡略化 ゆみこん 09/5/6(水) 7:10 発言[未読]
【61408】Re:同じ処理の簡略化 りん 09/5/6(水) 7:42 発言[未読]
【61411】Re:同じ処理の簡略化 neptune 09/5/6(水) 11:17 回答[未読]
【61412】Re:同じ処理の簡略化 たけ 09/5/7(木) 6:27 お礼[未読]

【61398】同じ処理の簡略化
質問  たけ  - 09/5/5(火) 23:07 -

引用なし
パスワード
   ExcelでのVBAは初めてになります.Accessでは多少の理解があります.
よろしくおねがいします.


次のデータを作成し,集計処理を考えております.

   A       B       C           D   
1                 朝
2      食事を取るか? 何人で食べるか? 食事時間がどのくらいか?
3 たろう      1      2           30
4 はなこ 
5 じろう 


サンプルでは朝のみですが,ここから昼,夜とB2:D2の内容が横に3回続きます.
なので,E2:G2が昼,H2:J2が夜となります.

●数値型
食事を取るか:YesNo
何人で:整数
食事時間:整数


今後の処理としては

○食事を取るか:Yesなら10点,Noなら0点
○何人で:2人以上でなら10点,1人でなら0点
○食事時間:20分以上なら10点,10分以上20分未満なら5点,10分未満なら0点

また,朝昼夜でそれぞれ別処理も考えております(夜の食事人数の加点を2倍にするなど)


今後の処理の部分については,If文にてイメージがつきますが,
朝昼夜と加算を除いて同じ処理となるため,それぞれをFor Next文などを使って
ひとまとめにグループで処理できると思うのですが…その構造が思いつきません.


うまく変数等を使って,スッキリとした構文の作り方を
教えていただけませんでしょうか?
よろしくお願いします.

【61401】Re:同じ処理の簡略化
発言  neptune  - 09/5/5(火) 23:42 -

引用なし
パスワード
   ▼たけ さん:
>ExcelでのVBAは初めてになります.Accessでは多少の理解があります.
Access VBAもという意味でよろしいですか?

>今後の処理の部分については,If文にてイメージがつきますが,
それを書いてみてくれませんか?

>朝昼夜と加算を除いて同じ処理となるため,それぞれをFor Next文などを使って
>ひとまとめにグループで処理できると思うのですが
1個の処理がかければ後は、その繰り返しですから、誰でも相談に乗ってくれますよ。

取りあえず、1個の処理を書いてUPしてみて下さい。
それを見て、まとめ方を考えませんか?

案(あまり考えてませんけど)としては、構造体の配列を使うとか、配列の
配列を使うとか、関数又はサブプロシージャにするとか。
・・・・関数が簡単かも?

集計処理ってどんなものですか?

【61403】Re:同じ処理の簡略化
発言  たけ  - 09/5/6(水) 0:38 -

引用なし
パスワード
   neptune 様
お世話になります.

AccessVBAについては,IfやSelectCaseの構文を改変した程度として
捉えてください.

あと,補足になります.
朝昼夜の後,列の追加で合計点を出します.
この辺は,VBAのfanctionを当てることになるかとおもいますが…

悩みの部分は2つ(現在までに)
1.行が変わったときにそれぞれセルを変更しなければならないため,
対応が出来ない(後の私が考えた構文を参照してください)

2.毎回,セルを固定した条件文となり,ダラダラと続いて
スマートな構文にならない.


とりあえず,ダラダラとなってしまう構文ですが.
(知識が少ないため,変数や型の宣言などで間違いがあるかと思いますが,
お許しください)

--------------------------------------------

Dim b1 As Integer
Dim b2 As Integer
Dim b3 As Integer

Dim l1 As Integer
Dim l2 As Integer
Dim l3 As Integer

Dim d1 As Integer
Dim d2 As Integer
Dim d3 As Integer


'朝食を食べる(回答が1)なら10,食べない(回答が2)なら0
If Cells(3, 2) = 1 Then
    b1 = 10
  ElseIf Cells(3, 2) = 2 Then
    b1 = 0
  Else
    b1 = Null
  

End If

'朝食を2人以上で食べるなら10,1人なら0
If Cells(3, 3) = 1 Then
  b2 = 0
  ElseIf Cells(3, 3) >= 2 Then
  b2 = 10
  Else
  b2 = Null
  
End If
  
'時間が20分以上なら10,10分以上20分未満なら5,10分未満なら0
Select Case Cells(3, 4)

  Case Is >= 20
    b3 = 10
  
  Case Is < 20
    b3 = 5
  
  Case Is < 10
    b3 = 0
  
  Case Else
    b3 = Null
    
End Select

'この後に,l1 l2 l3とd1 d2 d3の構文が続きます

'(省略)

'合計点を求めます
Dim total As Integer
Dim totalB As Integer
Dim totalL As Integer
Dim totalD As Integer

totalB = b1 + b2 + b3
totalL = l1 + l2 + l3
totalD = d1 + d2 + d3

total = totalB + totalL + totalD

--------------------------------------------

こんなイメージです.
b1〜b3とl1〜l3,d1〜d3が同じ規則での処理となるため,
この辺がスッキリ出来たらという思いと,対象者が変わったときにも
対応できるような状態にしたいと考えております.

不備な点がありましたら,ご指摘ください.

【61405】Re:同じ処理の簡略化
発言  ゆみこん  - 09/5/6(水) 7:10 -

引用なし
パスワード
   横から失礼して。

セルB3〜J3に値があるとします。
二次元配列を用いてみました。

Sub try()
  Dim r As Range
  Dim i As Integer, j As Integer
  Dim total(1 To 3, 1 To 3) As Variant

  i = 1 ' 1:朝食 2:昼食 3:夕食

  For Each r In Range("B3,E3,H3")
    j = r.Value ' 質問1
    total(i, 1) = IIf(j = 1, 10, IIf(j = 2, 0, Empty))

    j = r.Offset(, 1).Value ' 質問2
    total(i, 2) = IIf(j = 1, 0, IIf(j >= 2, 10, Empty))

    j = r.Offset(, 2).Value ' 質問3
    total(i, 3) = IIf(j >= 20, 10, IIf(j >= 10, 5, IIf(j < 10, 0, Empty)))

    i = i + 1
  Next
  '----------結果出力----------------------------
  Dim m As Integer, v As Variant
 
  v = Array("", "朝食", "昼食", "夕食")
  For m = 1 To 3
    MsgBox v(m) & "の質問1は " & total(m, 1) & vbLf & _
         v(m) & "の質問2は " & total(m, 2) & vbLf & _
         v(m) & "の質問3は " & total(m, 3) & vbLf & _
         v(m) & "の質問合計は " & total(m, 1) + total(m, 2) + total(m, 3)
  Next
End Sub

ご参考になれば。

【61408】Re:同じ処理の簡略化
発言  りん E-MAIL  - 09/5/6(水) 7:42 -

引用なし
パスワード
   たけ さん、おはようございます。

>AccessVBAについては,IfやSelectCaseの構文を改変した程度として
>捉えてください.

Funcionの一例です(標準モジュールに以下を記述)。

Sub test()
  Dim RR As Long
  For RR = 3 To 10
   With Application.ActiveSheet.Cells(RR, 1)
     If .Value = "" Then Exit For 'A列がカラだと抜ける
     MsgBox Format(GetMeals(.Offset(0, 1)), " 0点"), vbInformation, .Value & "得点"
   End With
  Next
End Sub
'
Function GetMeals(arg1 As Range) As Integer
  Dim NN(1 To 3) As Integer
  Dim RR As Long, CC As Long, TP As Integer
  RR = arg1.Row '行番号取得
  '
  With arg1.Parent
   For TP = 1 To 3
     NN(TP) = 0 '初期化
     CC = 2 + (TP - 1) * 3 '列初期位置
     '食べるか否か
     If .Cells(RR, CC).Value = 1 Then
      '食べる人は10点
      NN(TP) = NN(TP) + 10
      CC = CC + 1 '食べる人数:2人以上で10点
      If .Cells(RR, CC).Value >= 2 Then NN(TP) = NN(TP) + 10
      CC = CC + 1 '食事時間(複数に分岐)
      Select Case .Cells(RR, CC).Value
        Case Is >= 20: NN(TP) = NN(TP) + 10 '20分以上で10点
        Case Is >= 10: NN(TP) = 5      '10〜19分で5点
      End Select
     Else
      '否と無回答はスルー
     End If
   Next
  End With
  '例:夜は2倍
  NN(3) = NN(3) * 2
  '結果
  GetMeals = NN(1) + NN(2) + NN(3)
End Function

ちなみに、ワークシート関数としても使えます。
[K3セルの数式]=GetMeals(B3)
※参照するセルは同じ行ならどの列でもかまいません。

【61411】Re:同じ処理の簡略化
回答  neptune  - 09/5/6(水) 11:17 -

引用なし
パスワード
   ▼たけ さん:
こんにちは

たけ さんのソースを生かすように書いてみました。

コンパイルは通るようにしてますが、データを作るのが面倒くさかったんで
1行だけしか検証はしてません。
多分修正箇所は沢山あると思いますが、たたき台にはなると思います。

なお、VBの数値データ型にはnullの概念はないと思いますので -1 としています。
※この点は判断に使うなら問題ないですが、計算時の障害になるので、
 修正の必要があります。

Private Type Score
  Eat As Long     '食事を取る
  How_Many As Long  '何人
  Mealtime As Long  '食事時間
End Type

'昼,夜とB2:D2の内容が横に3回続きます.なので , E2: G2が昼 , H2: J2が夜となります
Sub t()
Dim typScoreMorning() As Score, typScoreNoon() As Score, typScoreNight() As Score
Dim gtl As Long
Dim b As Long, l As Long, d As Long
Dim targetRng As Range
Dim i As Long
Dim wsName As String

  'ワークシート名
  wsName = "Sheet1"

  '計算範囲を求める
  Set targetRng = Worksheets(wsName).Range(Range("B3"), Range("B3").End(xlDown))
  '
  ReDim typScoreMorning(targetRng.Count)
  ReDim typScoreNoon(targetRng.Count)
  ReDim typScoreNight(targetRng.Count)
  '行毎に計算
  For i = 0 To i = targetRng.Count
    typScoreMorning(i) = Judge(targetRng(i))
    typScoreNoon(i) = Judge(targetRng(i).Offset(, 4))  '4であっているのかな?
    typScoreNight(i) = Judge(targetRng(i).Offset(, 7))  '7であっているのかな?
  Next
  Set targetRng = Nothing
  
  '初期化
  b = 0
  l = 0
  d = 0
  '足し算(この辺りは必要に応じて適当に計算)
  For i = 0 To UBound(typScoreMorning) - 1
    '朝
    b = b + typScoreMorning(i).Eat
    l = l + typScoreMorning(i).How_Many
    d = d + typScoreMorning(i).Mealtime
'    '昼
'    b = b + typScoreNoon(i).Eat
'    l = l + typScoreNoon(i).How_Many
'    d = d + typScoreNoon(i).Mealtime
'
'    '夜
'    b = b + typScoreNight(i).Eat
'    l = l + typScoreNight(i).How_Many
'    d = d + typScoreNight(i).Mealtime
  Next i
  '総合計
  gtl = b + l + d
  MsgBox "朝の合計は: " & gtl
End Sub

'判定の条件、セルの位置関係などが変わった時はこの関数を直せばよい。
'○食事を取るか: Yesなら10点 , Noなら0点
'○何人で:2人以上でなら10点,1人でなら0点
'○食事時間:20分以上なら10点,10分以上20分未満なら5点,10分未満なら0点
Function Judge(pRng As Range) As Score
Dim typScore As Score

  '朝食を食べる(回答が1)なら10,食べない(回答が2)なら0
  If pRng.Value = 1 Then
      typScore.Eat = 10
  ElseIf pRng.Value = 2 Then
    typScore.Eat = 0
  Else
    typScore.Eat = -1  'nullはないので取りあえず-1とした。
  End If
  
  '朝食を2人以上で食べるなら10,1人なら0
  If pRng.Offset(, 1).Value = 1 Then
    typScore.How_Many = 0
  ElseIf pRng.Offset(, 1).Value >= 2 Then
    typScore.How_Many = 10
  Else
    typScore.How_Many = -1 'nullはないので取りあえず-1とした。
  End If

  '時間が20分以上なら10,10分以上20分未満なら5,10分未満なら0
  Select Case pRng.Offset(, 2).Value
    Case Is >= 20
      typScore.Mealtime = 10
    Case Is < 20
      typScore.Mealtime = 5
    Case Is < 10
      typScore.Mealtime = 0
    Case Else
      typScore.Mealtime = -1 'nullはないので取りあえず-1とした。
  End Select

  LSet Judge = typScore

End Function

他にも沢山サンプルを書いてくださってますので、ご自分に一番わかりやすい
方法でどうぞ。

【61412】Re:同じ処理の簡略化
お礼  たけ  - 09/5/7(木) 6:27 -

引用なし
パスワード
   返信が遅くなりました.
ゆみこんさん,りんさん,neptuneさん,回答ありがとうございました.

まだまだ勉強不足のため,ソースコードの一つ一つを理解しようと
本を読みながらそれぞれのコードを解析している状況です.

ちょっと時間がかかると思いますが,頑張ってみます.
一応,ここでスレッドを閉めますが,また分からないことが出てきましたら
教えてください.

どうもありがとうございました.

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