Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3565 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【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文などを使って
>ひとまとめにグループで処理できると思うのですが
１個の処理がかければ後は、その繰り返しですから、誰でも相談に乗ってくれますよ。

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

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

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


	【61403】Re:同じ処理の簡略化

たけ - 09/5/6(水) 0:38 -


	引用なし

	パスワード

neptune 様
お世話になります．

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

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

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

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

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

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

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 -


	引用なし

	パスワード

横から失礼して。

セルＢ３～Ｊ３に値があるとします。
二次元配列を用いてみました。

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 ' 質問１
　　　 total(i, 1) = IIf(j = 1, 10, IIf(j = 2, 0, Empty))

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

　　　 j = r.Offset(, 2).Value ' 質問３
　　　 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) & "の質問１は " & total(m, 1) & vbLf & _
　　　　　　　　v(m) & "の質問２は " & total(m, 2) & vbLf & _
　　　　　　　　v(m) & "の質問３は " & total(m, 3) & vbLf & _
　　　　　　　　v(m) & "の質問合計は " & total(m, 1) + total(m, 2) + total(m, 3)
　 Next
End Sub

ご参考になれば。


	【61408】Re:同じ処理の簡略化

りん

- 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 -


	引用なし

	パスワード

▼たけさん：
こんにちは

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

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

なお、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さん，回答ありがとうございました．

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

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3565 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free