[[20210703165749]]　『Sheet1とSheet2のセルを照合する』（万年マクロ）　ページの最後に飛ぶ

『Sheet1とSheet2のセルを照合する』（万年マクロ）

Sheet1に作成済みの「横書きのカレンダー」があります。Sheet2には知人の誕生日とその右隣のセルには「氏名」も記述している。Sheet1とSheet2とを照合し、期日が“合った”セルが有ったとき、Sheet2の誕生日の期日の右隣のセルの「氏名」を、Sheet1のカレンダーの期日の“下”に記述したいのでずが、マクロの基礎の無い小生には上手く「動きません」。どうかご教授願います。
Sub カレンダ横()

    Dim 元年月 As String
    Dim 年 As Integer
    Dim 月 As Integer
    Dim j As Long
    Dim カレンダ(1 To 12, 1 To 7)
    Dim cn As Integer
    Dim 曜日表示(1 To 1, 1 To 7)
    Dim cl As Range
    Dim k As Integer
    Dim 曜日
    Dim myr As Range
    Set myr = Worksheets("sheet2").Range("A2:A7")

    元年月 = Application.InputBox("2021/6の型で年月を記入", Type:=2)

    If 元年月 = "False" Or Not IsDate(元年月) Then
        MsgBox "終了しました"
        Exit Sub
      End If

    年 = Year(元年月)
    月 = Month(元年月)
    曜日 = Array("日", "月", "火", "水", "木", "金", "土")
    For k = 0 To 6
        曜日表示(1, k + 1) = 曜日(k)
     Next

    cn = 1
    For j = DateSerial(年, 月, 1) To DateSerial(年, 月 + 1, 0)
        If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 2
        カレンダ(cn, Weekday(j)) = Format(j, "yyyy/m/d")
      Next

    Application.ScreenUpdating = False
    Range("A:H").Clear
    Range("A1") = DateSerial(年, 月, 1)
    Range("B2").Resize(1, 7) = 曜日表示
    Range("B3").Resize(12, 7) = カレンダ

    Range("A1").NumberFormatLocal = "yyy""年""m""月"""
    Range("B2").Resize(13, 7).HorizontalAlignment = xlCenter
    Range("B3").Resize(12, 7).NumberFormatLocal = "d"

    Range("B2").Resize(13, 1).Font.Color = RGB(255, 0, 0)
    Range("H2").Resize(13, 1).Font.Color = RGB(0, 0, 255)

     For Each cl In Range("B3").Resize(12, 7)
        If Application.CountIf(myr, cl) > 0 Then
            cl.Offset(1).Value = myr.Offset(, 1).Value

            End If
       Next

     Application.ScreenUpdating = True

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 こんばんは　＾＾
日付は難しいですね、エクセル様が気をきかして2021/06/02とかに変換
するらしくて。。。＾＾；
方法は様々有るとは思いますが
レンジオブジェクトのValue2等をつかい、myrの日付分を整数に変換後
配列にでも格納して、整数どうしで比較し、myrの行を取得して
カレンダに格納すれば、出来ましたですよ。
（隠居じーさん） 2021/07/03(土) 18:43

 追伸　＾＾；
気が付いた点だけ。。。
シートは指定した方が良いと思いますよ。
うっかり、記入する表のシートがアクテイブになってたりすると
カレンダーが上書きされ、消えてしまいますよ
（隠居じーさん） 2021/07/03(土) 18:48

Sheet1とSheet2を照合するのにそのマクロおかしくないかい。
マクロ記録で確認したら。
（まくろしらず） 2021/07/03(土) 22:00

おはよ～ございます。
大変失礼致しました。。。
比較演算は。。。その、テキストどうしでうまく行っていると思います。
問題は、範囲の行を指定していないので、最初の1件のみが表示されているのだと
思いますので、ここを修正すればＯＫかと。。。でわでわ。済みませんでした
m(__)m
（隠居じーさん） 2021/07/04(日) 07:48

 おはよ～ございます。。。＾＾
下記のよ～な事でも。
バリアント型変数、x を追加定義、
エラー処理を付け加え、行を求めて、指定すればＯＫかと
シートは指定する様に変更してくださいね＾＾；。。。テスト中何度も消えてｗ(￣▽￣)
m(_ _)m
Dim x As Variant
     For Each cl In Range("B3").Resize(12, 7)

        'If Application.CountIf(myr, cl) > 0 Then
            'cl.Offset(1).Value = myr.Offset(, 1).Value
        'End If
        x = Application.Match(cl, myr, 0)
        If Not IsError(x) Then
            cl.Offset(1).Value = myr(x, 1).Offset(, 1).Value
        End If
     Next
（隠居じーさん） 2021/07/04(日) 08:09

コメント返信：

[ 一覧(最新更新順) ]

[[20210703165749]] 『Sheet1とSheet2のセルを照合する』（万年マクロ） ページの最後に飛ぶ

[[20210703165749]]　『Sheet1とSheet2のセルを照合する』（万年マクロ）　ページの最後に飛ぶ