エクセルVBAで、期間内にある指定した数字を自動入力

質問

下のように月日(A列)のみが書いてある表があります。
ここに定価を自動入力させたいと考えています。
ただ条件が複雑で・・・。
期間内にあるもので、曜日により値を振り分けする必要があります。
例えば、

■月日(from) 3/1
■月日(to) 3/3
■値　土・日・・・500
　　　月・・・・・450
このような条件で、下の[入力前]の表の「値」の列に
[入力前]
月日 　曜日 　　値
3/1 　　 (土)
3/2 　　 (日)
3/3 　　 (月)
3/4 　　 (火)
3/5 　　 (水)
3/6 　　 (木)

下のようにそれぞれ入力させたいのです。
[入力後]
月日 　曜日 　　 値
3/1 　　 (土) 　　 500
3/2 　　(日) 　　 500
3/3 　　 (月) 　　 450
3/4 　　 (火)
3/5 　　(水)
3/6 　　 (木)

どこかのスペースに
■月日(from) 3/1
■月日(to) 3/3
■値　土・日・・・500
　　　月・・・・・450
このような条件入力をするところを設けて、マクロを実行すると入力するようにしたいのですが、こんな複雑な振り分け設定ってVBAでもできるでしょうか？

回答No.4

Wendy02 · ベストアンサー

こんばんは。

#3 です。返事が遅くなってしまいました。（お礼側なら、メールが来るのですが、補足側は来ないのです。）

#3でも書いたように、元の構造的は、ものすごく単純なのですが、

>読み取ろうとしたのですが、知識不足で分からないところだらけでした。
2次元配列が出てきますから、なかなか、読みきれないと思います。知識不足ではなくて、「他人のコードは読みにくい」ということです。まして、今回の内容は、すこしトリッキーです。（^^;ただ、このようなコードを、読み取ろうとしたお気持ちには敬服いたします。

　　D　　　　　E　　　 F
>■月日(from) 3/1
>■月日(to) 3/3
>■値　　　土・日・・・500
>　　　　　月・・・・・450

この部分は、土・日というのは、正直言って、最初参りました。

その値のデータ部分を、以下の２次元配列で格納しています。
　　n = rng.Rows.Count - 1
　　ReDim arWeekday(1, n)

ここが1つのポイントです。なお、２次元配列は、このようにして、右側に入れていきます。
1次元側は、0　と　1　の二つの入れ物を用意して、「曜日」と「金額」をそれぞれ入れます。

arWeekday(1, n)　nは、変数で代入（配列の添え字は、0から始まりますから、入れ物の数は、必ず一つ減ります。n = rng.Rows.Count - 1　VB/VBAの特徴です。1からと書く人がいますが、それは、後々、混乱の元になるからやめたほうがよいです。必ず、「0」から始まると思っていたほうがよいです。）

今回は、固定で、Redim で配列変数を作ってしまっていますが、動的配列の場合は、必ず、右側を増やしていきます。一つのパターンのようにしておいたほうが無難です。動的配列で実行時エラーを起こさせないために、普段からこのような作り方をしています。

Application.ScreenUpdating = False　の前までを、一旦、ブレークポイントを設けて、配列変数の中身をローカルウィンドウで、確認していただいたほうがよいかもしれません。この使い方を覚えれば、本当にいろんな応用が利きます。とても便利です。

'--------------------------------------------

　　　　If IsDate(c.Value) Then
'　　このIsDate は、ワークシートの場合は、本来はなくてもよいです。（念のため）
　　　　　　If c.Value >= FirstDate And c.Value <= LastDate Then
' これは、日付の範囲を表したものですね。これは分かりますね。

'--------------------------------------------
ここが、2番目のポイントです。
　For j = 0 To n　
　'これは、1つ目のポイントで、格納した配列変数を一つずつ出します。
　　If InStr(arWeekday(0, j), Format$(c.Value, "aaa")) > 0 Then
　　'●ここの部分が重要です。-----下へ
　　　　c.Offset(, 2).Value = arWeekday(1, j)
　　　　Exit For
　　End If
Next j
'
●
If InStr(arWeekday(0, j), Format$(c.Value, "aaa")) > 0

arWeekday(0, j)　これが検索される側。つまり、土・日--500　と入っています。

つまり、一週間分が、それぞれ違っても良いということです。

その設定された日付(c.Value)を、Format$(c.Value, "aaa")　 曜日に変換して、設定された曜日（土・日）が入っているか、入っていたら、「1 以上」になりますから、値を代入する、ということになります。月～日　まで、重なる漢字がありませんから、「土日」でも、「土・日」でも、「土,日」 でもヒットします。
'------------------------------------------------

　　c.Offset(, 2).Value = arWeekday(1, j)
Exit For

後は、２次元配列の　arWeekday(1, j)　もう一つ、値側を代入してあげる、ということです。代入したら、後は、ループで検索は必要がないので、Exit For でループを抜けます。

'------------------------------------------------

一応、ここまでです。

ポイントの1番目は、マクロを覚える上では、重要な項目の一つです。2番目のポイントは、どちらかというとトリッキーな内容です。

そこで、私からの提案としては、もし、ご自身で今後マクロを考えるときは、以下のようにしたらよいかと思います。私は、ここの書き込みする時、最初、迷いましたが、あえて、設定条件を換えないことにしました。

　　D　　　　　E　　　 F
>■月日(from) 3/1
>■月日(to) 3/3
>■値　　　土・・・500
>　　　　　日・・・500
>　　　　　月・・・450
　　　　　　↑
　　　　　これらは、数値で表すことが出来ます。標準的には、日曜日が、「0」から始まり、土曜日「7」で終わります。例、1 と書いて、書式のユーザー設定で、「aaa」 としておきます。

言い換えると、日付も曜日もみんな数字だということです。数字の比較なら、簡単ですね。

マクロ側では、日付も曜日を、Weekday 関数で、数値に変換できますから、

wk = Weekday(日付)　'セルより代入
Select Case wk
Case 1 : v =500
Case 2 : v =400
Case 7 : v =500
End Select

というような風にすれば、簡単に出来てしまいます。

ただし、トリッキーな使い方としては、
Weekday(日付値, 最初の曜日)
を最初の曜日をずらしてあげると、

wk = Weekday(日付)　'セルより代入
wk = Weekday(mDate, vbMonday)
''wk が1になる。

''wk を　土曜日　6, 日曜日　7　にしてあげることも可能です。

そうすれば、
If wk >5 Then '6,7
　v = 500
ElseIf wk =1
　v =400
End If

という方法も可能です。一度、研究してみてください。
そうすれば、もっと分かりやすく簡単なコードになるはずです。

お礼

Wendy02さんこんばんは。くわしい説明ありがとうございました。半分も理解できていませんが、これ、覚えたいのでお手本にしておきたいと思います。こんな風にできるようになるかなぁ・・。ありがとうございます。

回答No.3

Wendy02

こんばんは。

>こんな複雑な振り分け設定ってVBAでもできるでしょうか？
というよりも、元はものすごく単純なマクロなのですが、以下のようなリクエストが入るととても複雑になります。本来は、シリアル値で全部行っていくほうが楽です。

　　D　　　　　E　　　 F
>■月日(from) 3/1
>■月日(to) 3/3
>■値　　　土・日・・・500
>　　　　　月・・・・・450
　　　↓
　　余計なデータは下にはないようにしてください。
　　曜日と金額のみの組み合わせだけです。

こういうことは、VBAプログラムにとっては、面倒ですね。

'標準モジュール
'-----------------------------------------
Sub TestMacro1()
　　Dim c As Range
　　Dim FirstDate As Date
　　Dim LastDate As Date
　　Dim rng As Range, i As Integer, j As Integer
　　Dim arWeekday() As Variant
　　Dim n As Integer
　　'----------------------------------
　　'設定場所
　　'開始日と終了日を入れる場所
　　FirstDate = Range("E1").Value
　　LastDate = Range("E2").Value
　　'データはE3以降に
　　Set rng = Range("E3", Range("E65536").End(xlUp).Offset(, 1))
　　'----------------------------------
　　If FirstDate = 0 Or LastDate = 0 Then
　　　MsgBox "開始日と終了日、両方を入力してください。", 48
　　　Exit Sub
　　End If

　　n = rng.Rows.Count - 1
　　ReDim arWeekday(1, n)
　　For i = 0 To n
　　　If rng.Cells(i + 1, 1).Value <> "" And rng.Cells(i + 1, 2).Value <> "" Then
　　　　arWeekday(0, i) = rng.Cells(i + 1, 1).Value
　　　　arWeekday(1, i) = rng.Cells(i + 1, 2).Value
　　　Else
　　　　MsgBox "曜日・価格、どちらかが抜け落ちがあるか、正しく書かれていません。", 48
　　　　Exit Sub
　　　End If
　　Next i

　　Application.ScreenUpdating = False
　　For Each c In Range("A2", Range("A65536").End(xlUp))
　　　　If IsDate(c.Value) Then
　　　　　　If c.Value >= FirstDate And c.Value <= LastDate Then
　　　　　　　For j = 0 To n
　　　　　　　　If InStr(arWeekday(0, j), Format$(c.Value, "aaa")) > 0 Then
　　　　　　　　　c.Offset(, 2).Value = arWeekday(1, j)
　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　　Next j
　　　　　　End If
　　　　　　'昇順に並んでいるなら、ここを活かす
　　　　　　'If c.Value > LastDate Then Exit Sub
　　　　End If
　　Next c
　　Application.ScreenUpdating = True
End Sub

補足

ご回等ありがとうございました。ためさせていただいて、パーフェクトでした。読み取ろうとしたのですが、知識不足で分からないところだらけでした。お手本にしたいのですが、もしできたらコードのコメントをつけていただければありがたいです。

回答No.2

imogasi

定価を決める要素が、曜日だけなら、関数のVLOOKUP関数で出来そうです。
VBAでもVLOOKUP関数は使えま。
既回答のように場合分けしなくても良い。
コード
Sub test01()
d = Range("A65536").End(xlUp).Row
MsgBox d
For i = 2 To d
Cells(i, "B") = Application.WorksheetFunction.VLookup(Weekday(Cells(i, "A")), Range("E1:F7"), 2, False)
Next i
End Sub
ーーー
結果　B列
A列　　B列　　C列（参考）　　　　　E列週・コ　F列（価格）
日付 価格 週コード 1 300
2008/2/1 500 6 2 200
2008/2/2 200 7 3 250
2008/2/3 300 1 4 100
2008/2/4 200 2 5 300
2008/2/5 250 3 6 500
2008/2/6 100 4 7 200
2008/2/7 300 5
2008/2/8 500 6

お礼

ご回等ありがとうございます。週コードという考え方参考になりました。

回答No.1

mshr1962

一例(日付・曜日・値がA2:C60000にあるとして)
D2="月日(from)",E2=2008/3/1
D3="月日(to)" ,E3=2008/3/3
D4="土・日"　　,E4=500
D5="月"　　　　,E5=450
として

Sub ATAISET()
　Dim RG As Range
　　For Each RG In Range("A2:A60000")　'日付の列を参照
　　　If RG >= Range("E2") And RG <= Range("E3") Then　'期間判定
　　　　Select Cace Format(RG,"aaa")　'曜日判定
　　　　Case "土","日"　'土・日の場合
　　　　　RG.Offset(0,2) = Range("E4")
　　　　Case "月"　　　 '月の場合
　　　　　RG.Offset(0,2) = Range("E5")
　　　　Case Else　　　 '上記以外
　　　　　RG.Offset(0,2) = ""
　　　　End Select
　　　End If
　　　If RG = "" Then Exit Sub '日付が空白ならマクロ終了
　　Next RG
End Sub

お礼

すぐにご回等いただいてありがとうございます。私の説明を読み取っていただいて恐縮です。