Excel2019 vba で他部署から送られてくる日程表を画像の日程リストのように氏名、始め、終わりの項目に分けて出力したいのですがうまくいきません。ご教示お願いします。

画像

Visual Basic | Visual Basic116閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0

回答ありがとうございます。 下記についてご教示願います。 教えていただいたコードを実行しましたが、例えば13行目のCD列が結合して顧客名が入力されている場合そちらも結合されていないセルと同様に終わりの欄のみ出力されてしまいます。下記コードのIf c = 3 And .Cells(r1, c).Merge = False Then で日程表3列目の値が結合でない場合の条件分岐を記載していただてますが、月の始めが結合セルの場合に始めと終わりを両方とも出力するにはどのようなコードを追記すれば良いでしょうか。 回答よろしくお願い致します。

ThanksImg質問者からのお礼コメント

ありがとうございました。

お礼日時:7/2 22:31

その他の回答(1件)

0

Sub a() '名前入力範囲において名前以外は文字が入力されてないこと '1日が3列目から始めっていることが前提です。 '可読性はあまりよくないかもです。 Dim ws1 As Worksheet Dim ws2 As Worksheet Dim c As Range Dim colTest As Collection Set ws1 = Worksheets("日程表") Set ws2 = Worksheets("日程リスト") Set colTest = New Collection For Each c In ws1.Range("C9:AG43").SpecialCells(xlCellTypeConstants, xlTextValues) If c.Value <> "" Then '半角スペースで区切って、名前、始め、終わりをコレクションに入れます colTest.Add Item:=c & Space(1) & c.Column - 2 & Space(1) & c.Column - 2 + c.MergeArea.Cells.Count - 1 End If Next c Dim i As Long Dim v As Variant For i = 1 To colTest.Count v = Split(colTest(i)) ws2.Cells(i + 1, 1) = v(0) '名前 If v(1) = v(2) Then 'セルの結合がなく If v(1) = 1 Then '1日だったら ws2.Cells(i + 1, 3) = v(2) '終わり Else ws2.Cells(i + 1, 2) = v(1) '始め End If Else ws2.Cells(i + 1, 2) = v(1) '始め ws2.Cells(i + 1, 3) = v(2) '終わり End If Next i End Sub