vbaおかしい

投稿者 : メ     投稿日時 : 2026/03/09(Mon) 07:19:51     OS : 未指定     EXCEL : 未指定

---

Option Explicit

'========================================
' メイン処理
' 外部データの色を取得して
' 入力シートと出力シートへ書き込む
'========================================
Sub データ更新()

    '画面更新を止めて高速化
    Application.ScreenUpdating = False
    
    '自動計算を停止（高速化）
    Application.Calculation = xlCalculationManual

    'ワークシート変数
    Dim wsIn As Worksheet      '入力シート
    Dim wsOut As Worksheet     '出力シート
    Dim wsExt As Worksheet     '外部データシート
    Dim wbExt As Workbook      '外部データブック

    '年月
    Dim Y As Long
    Dim M As Long

    'ループ用
    Dim i As Long
    
    '月の日数
    Dim lastDay As Long

    'シート設定
    Set wsIn = Worksheets("入力")
    Set wsOut = Worksheets("出力")

    '入力シートから年と月を取得
    Y = wsIn.Range("A1").Value
    M = wsIn.Range("B1").Value

    'その月の最終日を取得
    lastDay = Day(DateSerial(Y, M + 1, 0))

    '========================================
    ' 外部ブックを探す
    '========================================
    
    Dim wb As Workbook

    '現在開いているブックを順番に確認
    For Each wb In Workbooks
    
        'このブック自身は除外
        If wb.Name <> ThisWorkbook.Name Then
        
            '年と同じ名前のシートがあるか確認
            On Error Resume Next
            Set wsExt = wb.Worksheets(CStr(Y))
            On Error GoTo 0
            
            '見つかったら外部ブック確定
            If Not wsExt Is Nothing Then
                Set wbExt = wb
                Exit For
            End If
            
        End If
        
    Next

    '外部データが見つからない場合
    If wsExt Is Nothing Then
        MsgBox "外部データが見つかりません"
        GoTo EndProc
    End If

    '========================================
    ' シート初期化
    '========================================
    
    '2～40行の内容をクリア
    wsIn.Range("A2:B40").ClearContents
    wsOut.Range("A2:B40").ClearContents

    '========================================
    ' 日付と色を取得
    '========================================
    
    For i = 1 To lastDay
    
        '日付を入力
        wsIn.Cells(i + 1, 1).Value = DateSerial(Y, M, i)
        wsOut.Cells(i + 1, 1).Value = DateSerial(Y, M, i)
        
        '外部データのセル色を取得
        wsIn.Cells(i + 1, 2).Value = wsExt.Cells(i + 1, 1).Interior.Color
        wsOut.Cells(i + 1, 2).Value = wsExt.Cells(i + 1, 1).Interior.Color

    Next i

EndProc:

    '画面更新を戻す
    Application.ScreenUpdating = True
    
    '自動計算を戻す
    Application.Calculation = xlCalculationAutomatic

End Sub


'========================================
' 先月へ移動ボタン
'========================================
Sub 先月()

    Dim Y As Long
    Dim M As Long

    '入力シートから年と月取得
    With Worksheets("入力")

        Y = .Range("A1").Value
        M = .Range("B1").Value

        '月を1つ減らす
        M = M - 1

        '1月の場合は前年の12月へ
        If M = 0 Then
            M = 12
            Y = Y - 1
        End If

        'シートへ戻す
        .Range("A1") = Y
        .Range("B1") = M

    End With

    'データ更新
    Call データ更新

End Sub


'========================================
' 翌月へ移動ボタン
'========================================
Sub 翌月()

    Dim Y As Long
    Dim M As Long

    '入力シートから年と月取得
    With Worksheets("入力")

        Y = .Range("A1").Value
        M = .Range("B1").Value

        '月を1つ増やす
        M = M + 1

        '12月の場合は翌年の1月へ
        If M = 13 Then
            M = 1
            Y = Y + 1
        End If

        'シートへ戻す
        .Range("A1") = Y
        .Range("B1") = M

    End With

    'データ更新
    Call データ更新

End Sub

これを使用して、色を取得して、日にちことに色を変えていきたいのですができますか？
また、これを実行しても動きません。

投稿者 : 4x4my     投稿日時 : 2026/03/09(Mon) 08:19:53

---

vba「おかしい」って、何がどうおかしいのかは第三者には分かりません。
そもそもそのマクロでどういう処理をしたいのか、まずそれを説明しないと、長ったらしい「おかしい」コードなど読む気になれません。

それから違っていたらごめんなさいですが、投稿のたびに名前を変えるのやめましょうよ。