Excel初心者です。画像のように改行されるようにしたいのですがマクロ詳しい方いらっしゃいましたら教えていただきたいです。よろしくお願いします。 マクロのプログラムを貼っていただけたら

Excel初心者です。画像のように改行されるようにしたいのですがマクロ詳しい方いらっしゃいましたら教えていただきたいです。よろしくお願いします。 マクロのプログラムを貼っていただけたら 非常に助かります。

画像

Excel60閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0

以下でどうなりますか 標準モジュールに以下を記述し、Samp1 を実行してみます 処理対象は、アクティブシートの A1 ~ の表 結果は、新規シートに どうなりますか Option Explicit Public Sub Samp1()    Dim r As Range    Dim i As Long, j As Long, k As Long, n As Long    Const CC As Long = 3 ' 表上側の転記元行数    Const CRNG As String = "A1" ' 書出し位置    Application.ScreenUpdating = False    With ActiveSheet.Range("A1").CurrentRegion       With Worksheets.Add          Set r = .Range(CRNG)       End With       .Columns(1).Resize(CC).Copy       r.Offset(, 1).PasteSpecial Transpose:=True       Set r = r.Offset(1)       For i = CC + 1 To .Rows.Count          n = 0          For j = 2 To .Columns.Count             k = .Cells(i, j).Value             If (k > 0) Then                .Columns(j).Resize(CC).Copy                r.Offset(n, 1).Resize(k).PasteSpecial Transpose:=True                n = n + k             End If          Next          If (n > 0) Then             .Cells(i, 1).Copy r.Resize(n)             Set r = r.Offset(n)          End If       Next       Application.Goto r.Worksheet.Range(CRNG)    End With    Application.ScreenUpdating = True End Sub

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

回答ありがとうございます! 本当に助かりました! 早く正確な回答いただき感謝します!

お礼日時:2018/11/21 11:57