VBAで文字列の貼り付けが上手くいきません(追記有り)

Question

前提・実現したいこと

VBA初心者です、どうぞよろしくお願いします。
Excel2016のマクロで
2020年○月×日(月) →(月)形式の曜日を削除 →別のセルに文字列(例：43832 等のシリアル値)で貼り付け
を実現したいです。

コメントありがとうございます、追記です。
コピー元のセルの値は文字列です。手動で曜日を消すとセルの書式設定の通り日付表示(値貼り付けをしたらシリアル値)になります。

発生している問題・エラーメッセージ

日付のシリアル値ではなく、「2020年○月×日」の文字列でコピーされてしまいます。

該当のソースコード

Range("B604").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:="(月)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(火)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(水)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(木)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(金)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(土)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(日)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Copy
    Range("D7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

試したこと

コピー前のセル　→セルの書式を日付
コピー後のセル　→セルの書式を文字列
に変更し、手動でやると上手くいくのですが、マクロにすると上の問題が起きてしまいます。

補足情報（FW/ツールのバージョンなど）

特になし

Comments

[ttyp03]

「4から始まる5桁の数字」の変換ルールがわかりません。仕様を書かないと。

[ttyp03]

それからコピー元のセルの値はシリアル値でしょうか？文字列でしょうか？

[Hattrem]

お返事ありがとうございます。質問頂いた点を修正しました。
コピー元のセルの値は文字列です。

Answer 1

先走って回答しておきます。
元データがシリアル値か文字列かで処理方法が異なります。

' シリアル値の場合
Range("D7").Value = Range("B604").Value2

' 文字列の場合
ymd = Left(Range("B604").Value, InStr(Range("B604").Value, "(") - 1)
Range("D7").Value = CLng(DateSerial(Year(ymd), Month(ymd), Day(ymd)))

Comments

[ttyp03]

元データは文字列とのことで、後者の方でお試しください。

[Hattrem]

早速ご回答頂きありがとうございます！
こちらの修正箇所は
Range("B604")
Range("D7")
の2カ所(.Select)の前を置き換える形で合っておりますでしょうか？

シリアル値のコードも含め色々試してみたのですが、入れている位置が間違っているのか、やはり日付の表示は治らないままです。何度も申し訳ないです…。

[ttyp03]

> の2カ所(.Select)の前を置き換える形で合っておりますでしょうか？

この意味がよくわかりませんが、提示したコードで丸っと置き換えてもらえればいいです。

[ttyp03]

なんか他の回答のコメントを見ると伝わっていなそうなので再度。
今あるコードを以下に置き換えるだけでOKです。
ymd = Left(Range("B604").Value, InStr(Range("B604").Value, "(") - 1)
Range("D7").Value = CLng(DateSerial(Year(ymd), Month(ymd), Day(ymd)))
B604セルをシリアル値に変換したものをD7セルに代入します。
あ、B604セルから曜日も削除しないといけないのでしょうか。
それならばもう一行最後に追加してください。
Range("B604").Value = ymd

[Hattrem]

とても丁寧に教えて頂きありがとうございます。
頂いたアドバイスをもとに修正かけてみます！

Answer 2

あ、D列へ転記でしたか。。。。

Sub Macro1()
    With Range(Range("B604"), Cells(Rows.Count, "B").End(xlUp)).Offset(, 2)
        .Formula = "=DATEVALUE(LEFT(B604,FIND(""("",B604)-1))"
        .Value = .Value
        .NumberFormatLocal = "yyyy年m月d日"
    End With
End Sub

Sub Macro2()
    With Range(Range("B604"), Cells(Rows.Count, "B").End(xlUp))
        .NumberFormatLocal = "G/標準"
        .Replace What:="(*", Replacement:=""
        .Copy .Offset(, 2)
        .NumberFormatLocal = "yyyy""年""m""月""d""日""(aaa)"
    End With
End Sub

ああああああ？
昼寝してて気づいた。。。。。。。
「文字列で」でしたか＾＾；

Sub Macro1()
    With Range(Range("B604"), Cells(Rows.Count, "B").End(xlUp)).Offset(, 2)
        .Formula = "=""'""&DATEVALUE(LEFT(B1,FIND(""("",B1)-1))"
        .Value = .Value
    End With
End Sub

Sub Macro2()
    Dim rngFrom  As Range
    Dim rngTo As Range
    
    Set rngFrom = Range(Range("B604"), Cells(Rows.Count, "B").End(xlUp))
    Set rngTo = rngFrom.Offset(, 2)
    
    With rngFrom
        .NumberFormatLocal = "G/標準"
        .Replace What:="(*", Replacement:=""
        .NumberFormatLocal = "yyyy""年""m""月""d""日""(aaa)"
    End With
    
    With rngTo
        rngFrom.Copy .Cells
        .NumberFormatLocal = "@"
    End With
End Sub

括弧から後ろを消すなら、
月、火、水・・・・
と繰り返さずに
(*
としたら、1回で全部消えますよ。

Comments

[Hattrem]

早速のご回答ありがとうございます！
頂いたSubを追記してみたのですが、やはり上手くいきませんでした…。

```Excel VBA
Sub ボタン用()
'
' ボタン用 Macro
' オリジナルID作るためのマクロ
'

'

Range("E604:F607").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.NumberFormatLocal = "0_ "
Range("B604").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="(月)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(火)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(水)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(木)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(金)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(土)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(日)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Copy
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E604:F607").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D604").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Sub Macro1()
With Range(Range("B604"), Cells(Rows.Count, "B").End(xlUp)).Offset(, 2)
.Formula = "=DATEVALUE(LEFT(B604,FIND(""("",B604)-1))"
.Value = .Value
.NumberFormatLocal = "yyyy年m月d日"
End With
End Sub
```

[mattuwan]

上手く行かない。ではわかりません。
元の値と結果を貼り付けてください。

[Hattrem]

元の値　→2020年1月12日(日)
結果　→2020年1月12日
となっておりました。

上の回答の追記拝見しました、詳しく書いて頂きありがとうございます。
皆さまに頂いたアドバイスをもとに修正かけてみます！

Answer 3

コピー元の日付を "2020年01月01日(水)" のように必ず数字部分が8桁になるようにすれば、以下のコードでできます。（選択範囲に条件などは加えていないのであしからず。）

Sub MoveDate()
    Dim delRng As Range, copRng As Range, delRngVal As String
    Set delRng = Application.InputBox("コピー元のセルを選択", "選択", Type:=8)
    delRngVal = Left(delRng.Value, 4) & Mid(delRng.Value, 6, 2) & Mid(delRng.Value, 9, 2)
    Set copRng = Application.InputBox("コピー先のセルを選択", "選択", Type:=8)
    delRng.Value = ""
    copRng.Value = delRngVal
End Sub

Comments

[ttyp03]

これで得られるのはシリアル値ではないのでは？