Excel VBA質問箱 IV

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

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


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

1970 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【70743】日付の置換 レッズ命 11/12/23(金) 0:19

【70744】Re:日付の置換 Hirofumi 11/12/23(金) 8:40

【70745】Re:日付の置換 UO3 11/12/23(金) 9:43

【70746】Re:日付の置換 UO3 11/12/23(金) 9:54

【70747】Re:日付の置換 レッズ命 11/12/23(金) 15:30

【70748】Re:日付の置換 レッズ命 11/12/23(金) 16:56

【70749】Re:日付の置換 kanabun 11/12/23(金) 18:03

【70750】Re:日付の置換 kanabun 11/12/23(金) 18:36

【70751】Re:日付の置換 kanabun 11/12/23(金) 18:52


	【70743】日付の置換

レッズ命 - 11/12/23(金) 0:19 -


	引用なし

	パスワード

いつもお世話になっています。
どうしてもうまくいかないので、教えてください。
環境は、Vista、2007です。

下記のように作りました。
どこが悪いのでしょうか？

Private Sub Cmd作成_Click()

Dim 年 As Integer
Dim 月 As Integer
Dim 月末日 As Date
Dim セル As Range
Dim cell As Range

年 = Txt年.Value
月 = Txt月.Value
月末日 = Txt月末日.Value

Sheets("★月分").Copy After:=Sheets("★月分")
ActiveSheet.Name = 月 & "月分"

If 月 = 1 Then
For Each セル In Selection
　セル.Replace What:="/25", Replacement:=年 - 1 & "/12/25"
　セル.Replace What:="/27", Replacement:=年 - 1 & "/12/27"
　セル.Replace What:="/31", Replacement:=年 - 1 & "/12/31"
　セル.Replace What:="/1", Replacement:=年 & "/1/1"
　セル.Replace What:="/5", Replacement:=年 & "/1/5"
　セル.Replace What:="/6", Replacement:=年 & "/1/6"
　セル.Replace What:="/8", Replacement:=年 & "/1/8"
　セル.Replace What:="/20", Replacement:=年 & "/1/20"
　セル.Replace What:="/21", Replacement:=年 & "/1/21"
　セル.Replace What:="/24", Replacement:=年 & "/1/24"
Next セル
Else
For Each セル In Selection
　セル.Replace What:="/25", Replacement:=年 & "/" & 月 - 1 & "/25"
　セル.Replace What:="/27", Replacement:=年 & "/" & 月 - 1 & "/27"
　セル.Replace What:="/31", Replacement:=月末日
　セル.Replace What:="/1", Replacement:=年 & "/" & 月 & "/1"
　セル.Replace What:="/5", Replacement:=年 & "/" & 月 & "/5"
　セル.Replace What:="/6", Replacement:=年 & "/" & 月 & "/6"
　セル.Replace What:="/8", Replacement:=年 & "/" & 月 & "/8"
　セル.Replace What:="/20", Replacement:=年 & "/" & 月 & "/20"
　セル.Replace What:="/21", Replacement:=年 & "/" & 月 & "/21"
　セル.Replace What:="/24", Replacement:=年 & "/" & 月 & "/24"
Next セル
End If

End Sub

まったく置換えができません。
/25だけ置き換えられる時もあるのですが、
12/252012/1/2011となってしまいます。
ちなみに、Txt年.ValueはYear(Date) + 1が入っています。

教えてください。
よろしくお願いします。


	【70744】Re:日付の置換

Hirofumi - 11/12/23(金) 8:40 -


	引用なし

	パスワード

やりたい事を言葉（文書）で説明して下さい
コードだけでは何をやりたいのか解りません？

其れと、Txt年、Txt月、Txt月末日て何物？
そして、入っている値は、どんな物が入っているの？

また、「セル.Replace What:="/25", Replacement:=年 - 1 & "/12/25"」のセルて何？
値は、シリアル値？、文字列？
形式は？


	【70745】Re:日付の置換

UO3 - 11/12/23(金) 9:43 -


	引用なし

	パスワード

▼レッズ命さん：

こんにちは
アップされたコードを読むと、誤解する場合があります。
言葉でやりたいことを説明されると、やりとりがスムーズかと。
おそらくは、選択された領域に日付型のデータが入っており、それを
一ヶ月前の日付に置き換えたいということでしょうね。

DateAddという関数があります。１ヶ月前と指定すると1月の場合は前年の12月にしてくれます。
ただし、2011/3/29 の場合、2011/2/29　は存在しないので、2011/2/28 となります。

Sub Test()
　　Dim セル As Range
　　
　　For Each セル In Selection
　　　 If IsDate(セル.Value) Then セル.Value = DateAdd("m", -1, セル.Value)
　　Next
　　
End Sub


	【70746】Re:日付の置換

UO3 - 11/12/23(金) 9:54 -


	引用なし

	パスワード

追伸です

2011/3/31 の１ヶ月前も 2011/2/28 となります。
2011/10/31 の１ヶ月前は 2011/9/30 となります。

要は、存在しない日であれば、それより若い日で存在する日になります。
このあたりを、どうしたいかによって、判定ロジックなども加える必要が
あるかもしれませんね。


	【70747】Re:日付の置換

レッズ命 - 11/12/23(金) 15:30 -


	引用なし

	パスワード

▼Hirofumi さん：
▼U03 さん：

たいへん失礼しました。
元となるシートを毎月コピーして、使っていきたいのですが、
元のシートに/25とか/27というのがセルに入力してあるので、
それをその月分の2012/1/25とか2012/1/27とかに変換したいのです。
これでわかりますか？
ちなみに、/25とかがあるセルは固定しているので、
難しいようなら、Range("A1").value=年 - 1 & "/12/25"に
しようかとも思っていますが。

>Private Sub Cmd作成_Click()
>
>Dim 年 As Integer
>Dim 月 As Integer
>Dim 月末日 As Date
>Dim セル As Range
>Dim cell As Range
>
年 = Txt年.Value　　　　　　　←ここの部分は、ユーザーフォームで
月 = Txt月.Value　　　　　　　　何月分を作るかを質問させています。
月末日 = Txt月末日.Value　　基本的には、現在の翌月分を作るように
　　　　　　　　　　　　　　　　　　設定しています。

>Sheets("★月分").Copy After:=Sheets("★月分")
>ActiveSheet.Name = 月 & "月分"
>
>If 月 = 1 Then
> For Each セル In Selection
>　セル.Replace What:="/25", Replacement:=年 - 1 & "/12/25"
>　セル.Replace What:="/27", Replacement:=年 - 1 & "/12/27"
>　セル.Replace What:="/31", Replacement:=年 - 1 & "/12/31"
>　セル.Replace What:="/1", Replacement:=年 & "/1/1"
>　セル.Replace What:="/5", Replacement:=年 & "/1/5"
>　セル.Replace What:="/6", Replacement:=年 & "/1/6"
>　セル.Replace What:="/8", Replacement:=年 & "/1/8"
>　セル.Replace What:="/20", Replacement:=年 & "/1/20"
>　セル.Replace What:="/21", Replacement:=年 & "/1/21"
>　セル.Replace What:="/24", Replacement:=年 & "/1/24"
> Next セル
>Else
> For Each セル In Selection
>　セル.Replace What:="/25", Replacement:=年 & "/" & 月 - 1 & "/25"
>　セル.Replace What:="/27", Replacement:=年 & "/" & 月 - 1 & "/27"
>　セル.Replace What:="/31", Replacement:=月末日
>　セル.Replace What:="/1", Replacement:=年 & "/" & 月 & "/1"
>　セル.Replace What:="/5", Replacement:=年 & "/" & 月 & "/5"
>　セル.Replace What:="/6", Replacement:=年 & "/" & 月 & "/6"
>　セル.Replace What:="/8", Replacement:=年 & "/" & 月 & "/8"
>　セル.Replace What:="/20", Replacement:=年 & "/" & 月 & "/20"
>　セル.Replace What:="/21", Replacement:=年 & "/" & 月 & "/21"
>　セル.Replace What:="/24", Replacement:=年 & "/" & 月 & "/24"
> Next セル
>End If
>
>End Sub
>

>ちなみに、Txt年.ValueはYear(Date) + 1が入っています。
>


	【70748】Re:日付の置換

レッズ命 - 11/12/23(金) 16:56 -


	引用なし

	パスワード

▼Hirofumi さん：
▼U03 さん：

いろいろ考えていたら、この方法じゃできないことに気付きました。
Rangeでやることにしました。

ご回答ありがとうございました。


	【70749】Re:日付の置換

kanabun - 11/12/23(金) 18:03 -


	引用なし

	パスワード

▼レッズ命さん： >▼Hirofumi さん： >▼U03 さん： > >いろいろ考えていたら、この方法じゃできないことに気付きました。 >Rangeでやることにしました。そうですか？セルの値が "/1" とか "/25" とかあって、それをある日付データに置換したいなら、そのReplaceメソッドの引数 LookAtに「完全一致」を指定すればそのままのコードで、いけるんじゃないですか？ Sheets("★月分").Copy After:=Sheets("★月分") ActiveSheet.Name = 月 & "月分" With Range("A2", Cells(1, 1).End(xlDown)) 　　If 月 = 1 Then 　　　　For Each セル In .Cells 　　　　　セル.Replace "/25", 年 - 1 & "/12/25", LookAt:=xlWhole 　　　　　セル.Replace "/27", =年 - 1 & "/12/27", LookAt:=xlWhole 　　　　　セル.Replace "/31", 年 - 1 & "/12/31", LookAt:=xlWhole 　　　　　セル.Replace "/1", 年 & "/1/1", LookAt:=xlWhole 　　　　　セル.Replace "/5", 年 & "/1/5", LookAt:=xlWhole 　　　　　セル.Replace "/6", 年 & "/1/6", LookAt:=xlWhole 　　　　　セル.Replace "/8", 年 & "/1/8", LookAt:=xlWhole 　　　　　セル.Replace "/20", 年 & "/1/20", LookAt:=xlWhole 　　　　　セル.Replace "/21", 年 & "/1/21", LookAt:=xlWhole 　　　　　セル.Replace "/24", 年 & "/1/24", LookAt:=xlWhole 　　　　Next セル　　Else 　　　　For Each セル In .Cells 　　　　　セル.Replace What:="/25", Replacement:=年 & "/" & 月 - 1 & "/25", LookAt:=xlWhole 　　　　　セル.Replace What:="/27", Replacement:=年 & "/" & 月 - 1 & "/27", LookAt:=xlWhole 　　　　　セル.Replace What:="/31", Replacement:=月末日, LookAt:=xlWhole 　　　　　セル.Replace What:="/1", Replacement:=年 & "/" & 月 & "/1", LookAt:=xlWhole 　　　　　セル.Replace What:="/5", Replacement:=年 & "/" & 月 & "/5", LookAt:=xlWhole 　　　　　セル.Replace What:="/6", Replacement:=年 & "/" & 月 & "/6", LookAt:=xlWhole 　　　　　セル.Replace What:="/8", Replacement:=年 & "/" & 月 & "/8", LookAt:=xlWhole 　　　　　セル.Replace What:="/20", Replacement:=年 & "/" & 月 & "/20", LookAt:=xlWhole 　　　　　セル.Replace What:="/21", Replacement:=年 & "/" & 月 & "/21", LookAt:=xlWhole 　　　　　セル.Replace What:="/24", Replacement:=年 & "/" & 月 & "/24", LookAt:=xlWhole 　　　　Next セル　　End If End With


	【70750】Re:日付の置換

kanabun - 11/12/23(金) 18:36 -


	引用なし

	パスワード

▼レッズ命さん： >Rangeでやることにしました。以下のような方法のことですか？（途中から） Dim ss As String　’変数追加　Sheets("★月分").Copy After:=Sheets("★月分") 　ActiveSheet.Name = 月 & "月分" 　Range("A2", Cells(1, 1).End(xlDown)).Select 　If 月 = 1 Then 　　　For Each セル In Selection 　　　　ss = セル.Value 　　　　Select Case ss 　　　　　Case "/25": セル.Value = DateSerial(年 - 1, 12, 25) 　　　　　Case "/27": セル.Value = DateSerial(年 - 1, 12, 27) 　　　　　Case "/31": セル.Value = DateSerial(年, 1, 0) 　　　　　Case "/1", "/5", "/6", "/8", "/20", "/21", "/24" 　　　　　　　セル.Value = DateSerial(年, 月, Val(Mid$(ss, 2))) 　　　　End Select 　　　Next セル　Else 　　　For Each セル In Selection 　　　　ss = セル.Value 　　　　Select Case ss 　　　　　Case "/25": セル.Value = DateSerial(年, 月 - 1, 25) 　　　　　Case "/27": セル.Value = DateSerial(年, 月 - 1, 27) 　　　　　Case "/31": セル.Value = DateSerial(年, 月, 0) 　　　　　Case "/1", "/5", "/6", "/8", "/20", "/21", "/24" 　　　　　　　セル.Value = DateSerial(年, 月, Val(Mid$(ss, 2))) 　　　　End Select 　　　Next セル　End If


	【70751】Re:日付の置換

kanabun - 11/12/23(金) 18:52 -


	引用なし

	パスワード

▼レッズ命さん： >この方法じゃできないことに気付きました。 >Rangeでやることにしました。 Replaceメソッドでやるなら、セル範囲をループする必要はなかったですね With Range("A2", Cells(1, 1).End(xlDown))　'← 置換範囲適宜変更　　If 月 = 1 Then 　　　　.Replace "/25", DateSerial(年 - 1, 12, 25), xlWhole 　　　　.Replace "/27", DateSerial(年 - 1, 12, 27), xlWhole 　　　　.Replace "/31", DateSerial(年, 1, 0), xlWhole 　　Else 　　　　.Replace "/25", DateSerial(年, 月 - 1, 25), xlWhole 　　　　.Replace "/27", DateSerial(年, 月 - 1, 27), xlWhole 　　　　.Replace "/31", DateSerial(年, 月, 0), xlWhole 　　End If 　　.Replace "/1", DateSerial(年, 月, 1), xlWhole 　　.Replace "/5", DateSerial(年, 月, 5), xlWhole 　　.Replace "/6", DateSerial(年, 月, 6), xlWhole 　　.Replace "/8", DateSerial(年, 月, 8), xlWhole 　　.Replace "/20", DateSerial(年, 月, 20), xlWhole 　　.Replace "/21", DateSerial(年, 月, 21), xlWhole 　　.Replace "/24", DateSerial(年, 月, 24), xlWhole End With


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

1970 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free