エクセルのマクロについて教えて頂きたいことがあります。

画像

Excel71閲覧

ベストアンサー

0

その他の回答(3件)

0

注意 出力はSheet2です。変更は(B)を。 元表の左上隅の行・列のNoは、3行目で1列目から。変更は(A)を 元表に於いて、最左列の最終行は空セルではないことが前提 Sub ボタン1_Click()     Const StartR = 3, StartC = 1 '<---(A)          Dim Temp1(), N, Temp2 As Variant, N2     Dim LastR, LastC, R, C     Dim WS As Worksheet          Set WS = Worksheets("Sheet2") '<---(B)     WS.Cells.Clear          LastR = Cells(Rows.Count, StartC).End(xlUp).Row     For R = StartR To LastR         LastC = Cells(R, Columns.Count).End(xlToLeft).Column         N = 0         ReDim Temp1(1 To 1)         For C = StartC To LastC             If IsEmpty(Cells(R, C)) = False Then                 Temp2 = Split(Cells(R, C), " ")                 For N2 = LBound(Temp2) To UBound(Temp2)                     N = N + 1                     ReDim Preserve Temp1(1 To N)                     Temp1(N) = Temp2(N2)                 Next N2             End If         Next C         WS.Range(WS.Cells(R, 1), WS.Cells(R, UBound(Temp1))) = Temp1     Next R              WS.UsedRange.Columns.AutoFit     WS.UsedRange.HorizontalAlignment = xlCenter     WS.UsedRange.Borders.LineStyle = True End Sub

画像
0

A3セルから下、ということで Sub test() Dim i As Long, j As Long, k As Long, l As Long, D(), sp For i = 3 To Cells(Rows.Count, 1).End(xlUp).row For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column sp = Split(Cells(i, j), " ") For k = 0 To UBound(sp) ReDim Preserve D(l) D(l) = sp(k) l = l + 1 Next Next If k > 0 Then Cells(i, 1).Resize(, UBound(D) + 1) = D Erase D() End If l = 0 Next End Sub

もっと簡単な方法もあります。ただエクセルのバージョンがMS365限定です。 Sub Test() Dim i As Long, sp, mystr As String, D For i = 3 To Cells(Rows.Count, 1).End(xlUp).row mystr = WorksheetFunction.TextJoin(" ", True, Range(Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft))) If Len(mystr) Then D = Split(mystr, " ") Cells(i, 1).Resize(, UBound(D) + 1) = D End If Next End Sub

0

範囲また 全セルを選択 CRTL+Gキー セルを選択をクリック 添付の様に 空白セルにチェックをいれ OKを おせば 空白セルだけが 選択されますので 右クリックして 削除とします 削除方向を 聞いてきますので 左方向に チェックをいれれば 空白のみ 削除して 左に 詰めてくれます。

画像