コードを介して列を下ろして複数のロールに分割されたセル
次のデータ操作を作成するマクロを持つことを望んでいる:
返信リスト(回答:5)
どうぞ.必要に応じて定数frを変更します.これはデータのある最初の行です.
Sub SplitCells()
Const fr=2 '最初に確認する行
Dim r As Long
Dim lr As Long
Dim arr As Variant
Dim i As Long
Application.ScreenUpdating=False
lr=Range( "B"&Rows.Count).End(xlUp).Row
Range( "B"&fr& ":B"&lr).WrapText=False
For r=lr Tofrステップ-1
arr=Split(Range( "B"&r).Value、vbLf)
If UBound(arr)>0 Then
For i=UBound (arr)To 1 Step-1
If arr(i)<>"" Then
Range( "A"&r + 1).Resize(1、2).Insert Shift:= xlShiftDown
Range( "A"&r + 1).Value=Range( "A"&r).Value
Range( "B"&r + 1).Value=arr(i)
End If
Range( "B"&r).Value=arr(0)
Next i
End If
Next r
Application.ScreenUpdating=True
End Sub
応答1# ->にスキップ2 #RaderMはうまく機能します.
さまざまな用途に対してこの作品を確実にするために、次のようにカスタマイズできます.
-どの列に分割する必要があるセルが含まれているかを入力するためのユーザー?
-ユーザーは分割する必要がある複数の列を示すことができますか?
-分割する必要がない追加の列がある場合、その値は投稿の分割を保持することができますか?
下記のサンプル:
応答3# ->にスキップ4 #HansVMVこのversionをお試しください.SplitCellsMultiは実行するマクロです.
警告:行が多く、複数の列を分割する場合は、処理が遅くなる可能性があります.
Sub SplitCellsMulti()
Dim rng As Range
Dim col As Range
On Error Resume Next
Set rng=Application.InputBox(Prompt:= "必要な列を選択してください分割するには」、タイプ:= 8)
エラー時GoTo 0
rngが何もない場合
MsgBox「cpolumnsを選択していません！」、vbExclamation
Exit Sub
End If
Application.ScreenUpdating=False
For Each col In rng.Columns
SplitCells col.Column
Next col
Application.ScreenUpdating=True
End SubSub SplitCells(c As Long)
Const fr=2 '最初に確認する行
Dim r As Long
Dim lr As Long
Dim arr As Variant
Dim i As Long
lr=Cells(Rows.Count、c).End(xlUp).Row
Range(Cells(fr、c)、Cells(lr、c)).WrapText=False
For r=lr Tofrステップ-1
arr=Split(Cells(r、c).Value、vbLf)
If UBound(arr)>0 Then
For i=UBound(arr)To 1 Step-1
If arr(i)<>"" Then
Cells(r、1).EntireRow.Copy
Cells(r + 1、1).EntireRow.Insert
Cells(r + 1、 c).Value=arr(i)
End If
Cells(r、c).Value=arr(0)
Next i
End If
Next r
Application.CutCopyMode=False
End Sub