[[20240503213030]]　『横のセルの文字列を下のセルに移動』（ふるる）　ページの最後に飛ぶ

『横のセルの文字列を下のセルに移動』（ふるる）

A列　　　B列　　　C列　　D列　　　E列　　　　F列

日付　　曜日　　外出者　　外出者　　外出者　　外出者

1　　　　水　　　伊藤　　　鈴木　　　田中
2　　　　木　　　鈴木　　　坂本　　　佐々木
3　　　　金
6　　　　月　　　森　
7　　　　火　　　長谷川　　佐々木　　田中　　　加藤

↑のような表を
↓のような表に変えたいのですが
使える関数やVBAがありましたらご教示いただないでしょうか。
よろしくお願いいたします。
なお、4/28に類似の表で質問をしたところ、
クエリを使って変える方法を教えていただきました。
今回の表もクエリを使って↓のような表に変えることができましたが、
関数やVBAなどで操作数をもう少し減らした方法があったら
教えていただきたく投稿しました。
よろしくお願いいたします。

A列　　　B列　　　C列

日付　　曜日　　外出者

1　　　　水　　　伊藤
1　　　　水　　　鈴木
1　　　　水　　　田中
2　　　　木　　　鈴木
2　　　　木　　　坂本
2　　　　木　　　佐々木
3　　　　金
6　　　　月　　　森　
7　　　　火　　　長谷川
7　　　　火　　　佐々木
7　　　　火　　　田中
7　　　　火　　　加藤

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

 こうですか。

    Sub test()
        Dim v, w
        Dim i&, j&, k&
        Dim flg As Boolean
        v = Cells(1).CurrentRegion.Value
        ReDim w(1 To (UBound(v, 2) - 2) * UBound(v), 1 To 3)
        w(1, 1) = "日付": w(1, 2) = "曜日": w(1, 3) = "外出者"
        k = 2
        For i = 2 To UBound(v)
            flg = False
            For j = 3 To UBound(v, 2)
                If Not v(i, j) = Empty Then
                    w(k, 1) = v(i, 1)
                    w(k, 2) = v(i, 2)
                    w(k, 3) = v(i, j)
                    k = k + 1
                    flg = True
                End If
            Next
            If Not flg Then
                w(k, 1) = v(i, 1)
                w(k, 2) = v(i, 2)
                k = k + 1
            End If
        Next
        With Worksheets.Add.Cells(1).Resize(k, 3)
            .Value = w
            .Columns(1).NumberFormatLocal = "d"
            .Columns(2).NumberFormatLocal = "aaa"
        End With
    End Sub

 ※コードに不備があり、訂正しました。申し訳ありません。
（羊カウント） 2024/05/03(金) 22:43:01

羊カウント様

先日の回答に続き、今回も早々にご教示くださりありがとうございます。
またまた感激しました。
エクセル自体が初心者なのですが
前回のクエリ同様、今回のVBAも教えていただき勉強の幅が広がりました。
ありがとうございました。

（ふるる） 2024/05/04(土) 00:47:46

羊カウント様

教えていただいたコードを使って早速作業を始めたのですが、
なぜか不要な空白の行ができてしまい、
解決できずに図々しくもまた質問させていただこうと思っていました。
ところがスレッドを開いたら羊カウントさんから
訂正のコードが入っていてビックリ！
スッキリ希望通りの表にすることができました！
感激ひとしおです。
親切丁寧にご教示でくださりありがとうございました。

（ふるる） 2024/05/05(日) 08:47:06

コメント返信：

[ 一覧(最新更新順) ]

[[20240503213030]] 『横のセルの文字列を下のセルに移動』（ふるる） ページの最後に飛ぶ

[[20240503213030]]　『横のセルの文字列を下のセルに移動』（ふるる）　ページの最後に飛ぶ