[[20190628090615]] 『(マクロ)配列に取りこんだ文字列を日付形式に変換』(マイン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『(マクロ)配列に取りこんだ文字列を日付形式に変換させる方法』(マイン)

いつもお世話になっております。

配列内に「文字列」として取り込んだ値を

セルに書き出す際に「日付」に変換して書き出す方法について

アドバイスをお願いいたします。

処理概要は

勤務表にある個人行範囲内の日付に対し、配列2に配列1の日付データを転記し最終的に個人勤務欄に転記します。

・配列1:mList

 日付一覧のあるシート・・・Worksheets("公休マスタ")のA列(yyyy/mm/dd)

・配列2:cList

 処理行範囲・・・ActiveSheetの

 9行目〜最終行範囲に個人2行づつ使用
 5列目:35列目までが勤務欄

イメージとしては

配列2内に格納した勤務内容に「空欄・休・日付値」があれば

個人行A列にある日付を「基点日」として位置づけ

配列1内に格納した日付から「基点日」を探し出し

下方の値を、配列2の条件に一致した分に順次転記していく

と行ったイメージです。

全体の処理は正常に動作しておりますが、問題としては

配列1:mListのリストを

配列2:cListに転記する際に、日付として書き出しができているようなのですが、そのセルの条件付き書式が反応しません。

ただし、セルを直接選択してF2キー(セルダブルクリックするとセル値編集状態)を押すと

セルの書式設定(m/d)・条件付き書式(着色)

が反応します。

'--------------------------------------------------------------------
'個人勤務の値を書き換え

'日付は日付として格納しないとセル一括書き込み時に文字列となる
              
 If IsDate(cList(c)) Then
  cList(c) = CDate(mList(x))'←日付変換-------------------------------★ここ
 Else
  cList(c) = mList(x)
 End If
              
'--------------------------------------------------------------------

Sub 勤務表へ公休展開2()

    Dim sh1 As Worksheet: Set sh1 = ActiveSheet
    Dim sh2 As Worksheet: Set sh2 = Worksheets("公休マスタ")
    Dim i As Long, c As Long, m As Long    '行,列カウンタ
    Dim rc As Integer    'メッセージボックス用
    '処理確認用コード
    rc = MsgBox(Format(Cells(2, 2), "ggge""年""m""月""") & vbLf & vbLf & _
                "公休を展開します" & vbLf & vbLf, vbYesNo + vbQuestion, "公休展開")
    If rc = vbYes Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual    '条件付き書式の更新も停止するのか?
        '最終行/列取得
        Dim r As Long, col As Long
        r = sh1.Cells(Rows.Count, "B").End(xlUp).row + 1
        For col = sh1.Cells(5, 36).End(xlToLeft).Column To 1 Step -1
            If sh1.Cells(5, col) <> "" Then Exit For    '左方向1つ目値で抜ける
        Next col

        '//配列格納(日付マスタ範囲)
        Dim mList() As String: ReDim mList(0)
        For i = 2 To sh2.Cells(Rows.Count, "A").End(xlUp).row
            mList(UBound(mList)) = sh2.Cells(i, 1).Value
            ReDim Preserve mList(UBound(mList) + 1)
        Next i
        ReDim Preserve mList(UBound(mList) - 1)

        '(公休転記)
        For i = 9 To r Step 2
            '//配列格納(i行個人セル範囲)
            Dim cList() As String: ReDim cList(0)    '個人毎にIndex 0で初期化し再取り込み
            For m = 5 To col
                cList(UBound(cList)) = sh1.Cells(i, m).Value
                ReDim Preserve cList(UBound(cList) + 1)
            Next m
            ReDim Preserve cList(UBound(cList) - 1)

            '基準日(A列にある前月最終公休日)が日付形式かで分岐
            Dim key As String, x As Long
            If IsDate(sh1.Cells(i, 1)) Then
                key = sh1.Cells(i, 1)    '検索値:文字列で格納→リストにない場合の処理必要
                '日付マスタ配列内にあるか検索し番号取得
                x = Application.Match(key, mList, 0)
                '検索値があれば処理
                If Not IsError(x) Then
                    '個人勤務配列内データにアクセスし日付マスタ配列内の日付値を順番に書き換える
                    For c = LBound(cList) To UBound(cList)
                        '重要:値が「空欄」か「休」か「日付形式」の場合は
                        If cList(c) = "" Or cList(c) = "休" Or IsDate(cList(c)) Then

              '--------------------------------------------------------------------
              '個人勤務の値を書き換え

                            '日付は日付として格納しないとセル一括書き込み時に文字列となる
              
                            If IsDate(cList(c)) Then    
                                cList(c) = CDate(mList(x))'←日付変換-------------------------------★ここ
                            Else
                                cList(c) = mList(x)
                            End If
              
              '--------------------------------------------------------------------

                            x = x + 1    '日付マスタ内の日付位置から1つ下に移る
                        End If
                    Next c
                End If
            Else    '最終公休日が文字列の場合(日付以外)
                For c = LBound(cList) To UBound(cList)
                    '重要:値が「空欄」か「休」か「日付形式」の場合は
                    If cList(c) = "" Or cList(c) = "休" Then
                        cList(c) = key    '勤務書換:パート等一律「基準値」で埋める
                    End If
                Next c
            End If

            '(個人行配列データ結果をi行セル範囲に一括書き込み)
            sh1.Range(sh1.Cells(i, 5), sh1.Cells(i, col)) = cList

        Next i
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        MsgBox "終了"
    Else
        MsgBox "処理を中断します"
    End If
End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


すみません、以下の質問が続きがあることに気づかず投稿しましたので

この質問は改めて質問させていただきます。 

[[20190625075308]]09:07

『(マクロ)セルの作表方法について』(マイン)
(マイン) 2019/06/28(金) 10:10


 移動されているみたいだけど、これでやっていることの無意味さが解るのでは?

 Dim cList(1 To 5, 1 To 1) As String
 cList(1, 1) = "2019/1/1"
 cList(2, 1) = "2019/1/2"
 cList(3, 1) = "2019/1/3"
 cList(4, 1) = "2019/1/4"
 cList(5, 1) = "2019/1/5"
 Range("A1:A5").Value = cList
 For i = 1 To 5
     Cells(i, 2).Value = cList(i, 1)
 Next

 A1:A5を1セルづつWクリックするか、F2キー、Enterを押してみると・・・・。
 データ→区切り位置、完了でもいいけど。
(BJ) 2019/06/28(金) 10:53

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.