Excel VBA質問箱 IV

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

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


7461 / 13645 ツリー ←次へ | 前へ→

【38998】第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/15(木) 18:15 質問[未読]
【39002】Re:第○○曜日をyyyy/mm/ddに書き換えたい ハト 06/6/15(木) 19:06 回答[未読]
【39010】Re:第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/15(木) 21:40 お礼[未読]
【39003】Re:第○○曜日をyyyy/mm/ddに書き換えたい Statis 06/6/15(木) 19:30 回答[未読]
【39009】Re:第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/15(木) 21:38 質問[未読]
【39011】Re:第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/15(木) 22:03 質問[未読]
【39013】Re:第○○曜日をyyyy/mm/ddに書き換えたい Statis 06/6/16(金) 8:08 回答[未読]
【39043】Re:第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/16(金) 13:10 お礼[未読]
【39046】Re:第○○曜日をyyyy/mm/ddに書き換えたい Statis 06/6/16(金) 13:21 発言[未読]
【39016】Re:第○○曜日をyyyy/mm/ddに書き換えたい Jaka 06/6/16(金) 9:07 発言[未読]
【39045】Re:第○○曜日をyyyy/mm/ddに書き換えたい green 06/6/16(金) 13:11 お礼[未読]

【38998】第○○曜日をyyyy/mm/ddに書き換えたい
質問  green  - 06/6/15(木) 18:15 -

引用なし
パスワード
   どなたか教えてください。

第○○曜日とセルに書いてあるデータを今月の日付に書き換えたいのですが、
行き詰まっています。


例えば
第3土曜 なら⇒ 2006/6/17
第3日曜 なら⇒ 2006/6/18
としたいのです。

プログラムを書いてみましたが、これでは何曜日という事と、土日の第○週というカウント
だけしか得られず、どう修正してよいか困っています。


Sub Main()

Dim yobi As Integer '曜日コード
Dim hi As Date '日付

Dim sta_cnt as integer '土曜○週
Dim sun_cnt as integer ’日曜○週

Dim cur_stdate As Date '初日
Dim sd As Integer
Dim cur_eddate As Date '月末
Dim ed As Integer
Dim lp As Integer 'ループ


cur_date = DateSerial(Year(Date), Month(Date), 1) '現在の月の初日
sd = Day(cur_date)
cur_eddate = DateSerial(Year(Date), Month(Date) + 1, 0) '現在の月の最後
ed = Day(cur_eddate)


For lp = sd To ed

   hi = DateSerial(Year(Date), Month(Date), lp) '現在の月の初日
   yobi = Format(hi, "w")
   Debug.Print "yobi="; yobi
   
   If yobi = 7 Then
    sta_cnt = sta_cnt + 1
   
  
   ElseIf yobi = 1 Then
    sun_cnt = sun_cnt + 1
   End If
Next

end sub


どなたか教えてください宜しくお願いいたします。

【39002】Re:第○○曜日をyyyy/mm/ddに書き換えたい
回答  ハト  - 06/6/15(木) 19:06 -

引用なし
パスワード
   こんばんは

↓のような感じですかね?
アレンジしてみてください

Sub D_CNT()

Dim ws As Worksheet
Dim SDate As String
Dim WName As String
Dim TDate As Date
Dim TD As Integer
Dim WD As Integer
Dim WC As Integer
Dim CNT As Integer
Dim i As Integer

  Set ws = ThisWorkbook.Worksheets("Sheet1")
  
  SDate = ws.Range("A1").Text
  
  If SDate = "" Then
    MsgBox "NODATA"
    Exit Sub
  End If
  
  If InStr(SDate, "土曜") <> 0 Then
    WD = 7
    i = InStr(SDate, "土曜")
  ElseIf InStr(SDate, "日曜") <> 0 Then
    WD = 1
    i = InStr(SDate, "日曜")
  Else
    MsgBox "DATA ERROR"
    Exit Sub
  End If
  
  WC = CInt(Mid(SDate, i - 1, 1))
  
  If WC < 1 Or WC > 5 Then
    MsgBox "DATA ERROR"
    Exit Sub
  End If
  
  TDate = DateSerial(Year(Date), Month(Date), 1)
  
  TD = Weekday(TDate)
  
  If WD > TD Then
    CNT = WD - TD
  ElseIf WD < TD Then
    CNT = WD + 7 - TD
  Else
    CNT = 0
  End If
  
  CNT = CNT + (WC - 1) * 7
  TDate = DateAdd("d", CNT, TDate)
  
  ws.Range("B1") = TDate
  
End Sub

【39003】Re:第○○曜日をyyyy/mm/ddに書き換えたい
回答  Statis  - 06/6/15(木) 19:30 -

引用なし
パスワード
   こんにちは

アクティブシートのA列に「第1土曜日」と記載後
実行してくださいB列に日付が表示されます。
  A    B
第1土曜日    2006/6/3
第1日曜日    2006/6/4
第2土曜日    2006/6/10
第2日曜日    2006/6/11
第3土曜日    2006/6/17
第3日曜日    2006/6/18
第4土曜日    2006/6/24
第4日曜日    2006/6/25

上記のようになるはずです。


Sub Test()
Dim Myda As Date, cur_date As Date, cur_eddate As Date, lp As Long
Dim Co As Long, Co1 As Long, DaSt(4) As String, DaSt1(4) As Date
Dim DaSu(4) As String, DaSu1(4) As Date, C As Range, Ma, Ma1

Myda = Date
cur_date = DateSerial(Year(Myda), Month(Myda), 1) '現在の月の初日
cur_eddate = DateSerial(Year(Myda), Month(Myda) + 1, 0) '現在の月の最後
Co = 1: Co1 = 1
For lp = 0 To DateDiff("d", cur_date, cur_eddate)
 
  Select Case Weekday(Format(DateAdd("d", lp, cur_date), "yyyy/m/d"))
      Case 7
      DaSt(Co) = "第" & Co & "土曜日"
      DaSt1(Co) = Format(DateAdd("d", lp, cur_date), "yyyy/m/d")
      Co = Co + 1
      Case 1
      DaSu(Co1) = "第" & Co1 & "日曜日"
      DaSu1(Co1) = Format(DateAdd("d", lp, cur_date), "yyyy/m/d")
      Co1 = Co1 + 1
  End Select
Next
For Each C In Range("A1", Range("A65536").End(xlUp))
  Ma = Application.Match(C.Value, DaSt, 0)
  If Not IsError(Ma) Then
    C.Offset(, 1).Value = DaSt1(Ma - 1)
  Else
    Ma1 = Application.Match(C.Value, DaSu, 0)
    If Not IsError(Ma1) Then
     C.Offset(, 1).Value = DaSu1(Ma1 - 1)
    End If
  End If
Next
End Sub

【39009】Re:第○○曜日をyyyy/mm/ddに書き換えたい
質問  green  - 06/6/15(木) 21:38 -

引用なし
パスワード
   Statis さん:

こんばんわ。
早速プログラム参考にさせていただいております。
質問です。

>For Each C In Range("A1", Range("A65536").End(xlUp))
>  Ma = Application.Match(C.Value, DaSt, 0)
>  If Not IsError(Ma) Then
>    C.Offset(, 1).Value = DaSt1(Ma - 1)
>  Else
>    Ma1 = Application.Match(C.Value, DaSu, 0)
>    If Not IsError(Ma1) Then
>     C.Offset(, 1).Value = DaSu1(Ma1 - 1)
>    End If
>  End If
>Next


上記プログラム部分ですが、A1列の最終行までを選択しているところまでは
理解できますが、

>  Ma = Application.Match(C.Value, DaSt, 0)
>  If Not IsError(Ma) Then
>    C.Offset(, 1).Value = DaSt1(Ma - 1)
>  Else
>    Ma1 = Application.Match(C.Value, DaSu, 0)
>    If Not IsError(Ma1) Then
>     C.Offset(, 1).Value = DaSu1(Ma1 - 1)
>    End If

この部分の処理が詳しく理解できないでいます。
コメント頂けると大変助かります。

【39010】Re:第○○曜日をyyyy/mm/ddに書き換えたい
お礼  green  - 06/6/15(木) 21:40 -

引用なし
パスワード
   ハト さん:

こんばんは
大変参考になるプログラムを有難うございました。
勉強させていただきます。

【39011】Re:第○○曜日をyyyy/mm/ddに書き換えたい
質問  green  - 06/6/15(木) 22:03 -

引用なし
パスワード
   度々の質問で申し訳ありません。
A列のデータをB列に書き込むのではなくA列を置換させたいのです。

工夫して
C.Offset(, 0).Value = DaSt1(Ma - 1) としてみましたが
エラーとなってしまいます。
ご伝授いただければ幸いです。

【39013】Re:第○○曜日をyyyy/mm/ddに書き換えたい
回答  Statis  - 06/6/16(金) 8:08 -

引用なし
パスワード
   こんにちは

簡単な説明を入れときました。


Sub Test()
Dim Myda As Date, cur_date As Date, cur_eddate As Date, lp As Long
Dim Co As Long, Co1 As Long, DaSt(4) As String, DaSt1(4) As Date
Dim DaSu(4) As String, DaSu1(4) As Date, C As Range, Ma, Ma1

Myda = Date
cur_date = DateSerial(Year(Myda), Month(Myda), 1) '現在の月の初日
cur_eddate = DateSerial(Year(Myda), Month(Myda) + 1, 0) '現在の月の最後
Co = 1: Co1 = 1
''現在の月の初日から'現在の月の最後日までループさせる
For lp = 0 To DateDiff("d", cur_date, cur_eddate)
  'Weekday関数にて曜日を区分(土曜、日曜のみ)
  Select Case Weekday(Format(DateAdd("d", lp, cur_date), "yyyy/m/d"))
      Case 7
      'その日が土曜なら配列変数に第何土曜日かをセット(変数Coにて1,2,3,4,5を決める)
      DaSt(Co) = "第" & Co & "土曜日"
      'その日を配列変数にセット
      DaSt1(Co) = Format(DateAdd("d", lp, cur_date), "yyyy/m/d")
      Co = Co + 1
      Case 1
      'その日が日曜なら配列変数に第何日曜日かをセット(変数Co1にて1,2,3,4,5を決める)
      DaSu(Co1) = "第" & Co1 & "日曜日"
      'その日を配列変数にセット
      DaSu1(Co1) = Format(DateAdd("d", lp, cur_date), "yyyy/m/d")
      Co1 = Co1 + 1
  End Select
Next
'ループにてデータ分回す
For Each C In Range("A1", Range("A65536").End(xlUp))
  'Match関数にて配列変数の値と一致するのがあるかを確認(土曜日分)
  Ma = Application.Match(C.Value, DaSt, 0)
  '一致したかの有無をIF文で確認
  If Not IsError(Ma) Then
    'あった場合セルへ日付を転記(土曜日分)
    C.Value = DaSt1(Ma - 1)
  Else
    '無かった場合、Match関数にて配列変数の値と一致するのがあるかを確認(日曜日分)
    Ma1 = Application.Match(C.Value, DaSu, 0)
    '一致したかの有無をIF文で確認
    If Not IsError(Ma1) Then
     'あった場合セルへ日付を転記(日曜日分)
     C.Value = DaSu1(Ma1 - 1)
    End If
  End If
Next
End Sub

>C.Value = DaSu1(Ma1 - 1)
なぜ、(Ma1-1)になるかと言うと変数「DaSu1」は
DaSu1(0),DaSu1(1),DaSu1(2),DaSu1(3),DaSu1(4)となり
各変数に値がセットされいます。
Match関数で一致した場合、変数Ma1には「1〜5」の値が返ってきます。
と言う事は、実際の値を転記するには「1=DaSu1(0)」となるため
「-1」する必要があるのです。

【39016】Re:第○○曜日をyyyy/mm/ddに書き換えたい
発言  Jaka  - 06/6/16(金) 9:07 -

引用なし
パスワード
   第○の番号と曜日を番号に変えればこれでできます。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=37;id=FAQ

【39043】Re:第○○曜日をyyyy/mm/ddに書き換えたい
お礼  green  - 06/6/16(金) 13:10 -

引用なし
パスワード
   Statis さん

こんにちは
朝早くからご説明いただきありがとうございました。
月によっては第5週まで存在する場合があるということに
気が付きました。

宣言部分
Dim Co As Long, Co1 As Long, DaSt(4) As String, DaSt1(4) As Date
Dim DaSu(4) As String, DaSu1(4) As Date, C As Range, Ma, Ma1

以下のように修正させていただきました。
Dim Co As Long, Co1 As Long, DaSt(5) As String, DaSt1(5) As Date
Dim DaSu(5) As String, DaSu1(5) As Date, C As Range, Ma, Ma1


ご協力大変感謝しております。
ありがとうございました。

【39045】Re:第○○曜日をyyyy/mm/ddに書き換えたい
お礼  green  - 06/6/16(金) 13:11 -

引用なし
パスワード
   Jaka さん

こんにちは
朝早くからアドバイスいただきありがとうございます。
参考にさせていただけることが沢山ありました。
ありがとうございます。

【39046】Re:第○○曜日をyyyy/mm/ddに書き換えたい
発言  Statis  - 06/6/16(金) 13:21 -

引用なし
パスワード
   ▼green さん:
>こんにちは
>宣言部分
>Dim Co As Long, Co1 As Long, DaSt(4) As String, DaSt1(4) As Date
>Dim DaSu(4) As String, DaSu1(4) As Date, C As Range, Ma, Ma1
>
>以下のように修正させていただきました。
>Dim Co As Long, Co1 As Long, DaSt(5) As String, DaSt1(5) As Date
>Dim DaSu(5) As String, DaSu1(5) As Date, C As Range, Ma, Ma1

解決済みですが。
上記の宣言だと変数の要素は「6」になりますよ
DaSu1(4)=Dasu1(0),Dasu1(1),Dasu1(2),Dasu1(3),Dasu1(4)
ですから
動作には問題ないですが?

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