CHR（10）で分割してセルを移動する方法は？

Question

私はこのようなデータを含む細胞をたくさん持っています。

1. 更新貸出情報

2. 私は4つの別々のセルにそれを分割したい貸出情報

3. 更新フェア情報

4. が情報に

を承認承認し、引き下げる ColAおよびColCのデータ。

したがって、A1：C1がこのように見える場合。

7 1. Update Lending Information Conditional on question(s): 
    2. Approve Lending Information 
    3. Update Fair Information 
    4. Approve Information 

コード実行後にA4：C4が表示されます。

7  1. Update Lending Information Conditional on question(s): 
7  2. Approve Lending Information Conditional on question(s): 
7  3. Update Fair Information  Conditional on question(s): 
7  4. Approve Information   Conditional on question(s): 

これは私の動作しないコードです。

Sub TestingScript() 

Dim c As Integer 
LRow = Sheets("Exception Report").Range("A" & Rows.Count).End(xlUp).Row 

For c = LRow To 1 Step -1 
    Range("B" & c).Select 
    splitVals = Split(ActiveSheet.Range("B" & c).Value, Chr(10)) 
    totalVals = UBound(splitVals)/2 
    Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(ActiveCell.Row + 1 + totalVals, ActiveCell.Column)).Value = splitVals 

    'With Range("A:A").SpecialCells(xlCellTypeBlanks) 
    ' .FormulaR1C1 = "=R[-1]C" 
    ' .Value = .Value 
    'End With 
Next c 

End Sub 

Answer 1

あなたはこれを試みることができる：

Option Explicit 

Sub main() 
    Dim iRow As Long, nRows As Long 
    Dim arr As Variant 

    With Sheets("Exception Report") 
     For iRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1 
      With .Cells(iRow, 1) 
       arr = Split(.Offset(, 1).value, Chr(10)) 
       nRows = UBound(arr) 
       .Offset(1).Resize(nRows).EntireRow.Insert xlShiftDown 
       .Resize(nRows + 1).value = .value 
       .Offset(, 1).Resize(nRows + 1).value = .Application.Transpose(arr) 
       .Offset(, 2).Resize(nRows + 1).value = .Offset(, 2).value 
      End With 
     Next 
    End With 
End Sub