| |
▼たけ さん：
こんにちは
たけ さんのソースを生かすように書いてみました。
コンパイルは通るようにしてますが、データを作るのが面倒くさかったんで
１行だけしか検証はしてません。
多分修正箇所は沢山あると思いますが、たたき台にはなると思います。
なお、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
他にも沢山サンプルを書いてくださってますので、ご自分に一番わかりやすい
方法でどうぞ。
|
|
neptune
- 09/5/6(水) 11:17 -
