VBA回车和填充代码

我真的是vba新手，如果能在我遇到的以下问题上得到任何帮助，我将不胜感激

问题描述（与下图相关）： 1*）在c中，我已经成功地分离了返回车厢，这导致2*）现在每个返回车厢都有自己的行，我需要填写两侧的b列和c列，如结果3*）所示

我已经包括了我的原始代码供大家检查，我目前被困在如何进入第3步

Sub InString()

Dim rColumn As Range 'Set this to the column which needs to be worked through
Dim lFirstRow As Long
Dim lLastRow As Long
Dim lRow As Long 'Difference between first and last row
Dim lLFs As Long
Dim rRow As Range 'This will be used to drag the fill down between rows


Set rColumn = Columns("N")
lFirstRow = 2 'Starting may need to be adjusted, if additional columns are added
lLastRow = rColumn.Cells(Rows.Count).End(xlUp).Row

For lRow = lLastRow To lFirstRow Step -1
lLFs = Len(rColumn.Cells(lRow)) - Len(Replace(rColumn.Cells(lRow), vbLf, ""))
If lLFs > 0 Then
     rColumn.Cells(lRow + 1).Resize(lLFs).EntireRow.Insert shift:=xlShiftDown 'added EntireRow to before insert, to bring whole row down, instead of previous issue where only rColumn was shifted down.
     rColumn.Cells(lRow).Resize(lLFs + 1).Value = Application.Transpose(Split(rColumn.Cells(lRow), vbLf))
    End If
Next lRow

端接头

---

谢谢，

我刚刚在末尾添加了一个循环，查找空格-

Sub InString()

Dim rColumn As Range 'Set this to the column which needs to be worked through
Dim lFirstRow As Long
Dim lLastRow As Long
Dim lRow As Long 'Difference between first and last row
Dim lLFs As Long
Dim rRow As Range 'This will be used to drag the fill down between rows
Dim strVal As String

Set rColumn = Columns("N")
lFirstRow = 2 'Starting may need to be adjusted, if additional columns are added
lLastRow = rColumn.Cells(Rows.Count).End(xlUp).row

For lRow = lLastRow To lFirstRow Step -1
lLFs = Len(rColumn.Cells(lRow)) - Len(Replace(rColumn.Cells(lRow), vbLf, ""))
If lLFs > 0 Then
     rColumn.Cells(lRow + 1).Resize(lLFs).EntireRow.Insert shift:=xlShiftDown 'added EntireRow to before insert, to bring whole row down, instead of previous issue where only rColumn was shifted down.
     rColumn.Cells(lRow).Resize(lLFs + 1).Value = Application.Transpose(Split(rColumn.Cells(lRow), vbLf))
    End If
Next lRow

lLastRow = rColumn.Cells(Rows.Count).End(xlUp).row
Dim rColNum As Integer
rColNum = rColumn.Column
For i = 2 To lLastRow
    If Cells(i, rColNum - 1) = "" Then
    Cells(i, rColNum - 1) = Cells(i - 1, rColNum - 1)
    Cells(i, rColNum + 1) = Cells(i - 1, rColNum + 1)
    End If
Next
End Sub

基本上这部分-

For i = 2 To lLastRow
    If Cells(i, rColNum - 1) = "" Then
    Cells(i, rColNum - 1) = Cells(i - 1, rColNum - 1)
    Cells(i, rColNum + 1) = Cells(i - 1, rColNum + 1)
    End If
Next

例如，查看刚刚拆分的列中的每一行，看看左边的单元格是否为空。如果是，则使其与上面的单元格相同，并使右侧的单元格与上面的单元格相同

要扩展，您可以说

    if Cells(i, rColNum - 1) = "" Then
    Cells(i, rColNum - 1) = Cells(i - 1, rColNum - 1)
    Cells(i, rColNum + 1) = Cells(i - 1, rColNum + 1)
    Cells(i, rColNum - 2) = Cells(i - 1, rColNum - 2)
    Cells(i, rColNum + 2) = Cells(i - 1, rColNum + 2)
    End If

---

如果您想覆盖

rcolumn

两侧相邻的两列，假设您的输入数据位于

B、D和E列（如图表所示），那么我认为这就可以完成工作：

Sub OrderData()
    Dim inputData As Range, temp() As Variant, splitData As Variant, i As Integer, j As Integer, rw As Long

    Set inputData = Range("B1:E2") //Update to reflect your data
    temp = inputData.Value
    inputData.ClearContents

    rw = 1
    For i = 1 To UBound(temp)
        splitData = Split(temp(i, 2), ",")

        For j = 0 To UBound(splitData)
            Cells(rw, 2) = temp(i, 1)
            Cells(rw, 3) = splitData(j)
            Cells(rw, 5) = temp(i, 4)
            rw = rw + 1
        Next j
    Next i
End Sub

为什么不在第一行+1到最后一行=第一行+1之间的每个单元格中？嗨，我不确定我是否理解你的意思，请你详细说明一下，你的回车在哪里？您拥有的宏-我不明白它是如何在1上工作的，以2到达2回车符在1*中显示为逗号，例如1（回车符）2（回车符）3（回车符）4（回车符）在1,2,3,4中。谢谢，这很好。-这只是一个后续问题，但如果我想覆盖其他列以在e之后执行相同的操作，例如，列f，g，h，我需要调整单元格参数的哪一部分以覆盖其他列？如果你想说覆盖e，f，g，h，那么你需要将for循环改为包含
rcolnum-1
和+1，-2， +2@DJHenza我在答案上加了一个解释。
Sub OrderData()
    Dim inputData As Range, temp() As Variant, splitData As Variant, i As Integer, j As Integer, rw As Long

    Set inputData = Range("B1:E2") //Update to reflect your data
    temp = inputData.Value
    inputData.ClearContents

    rw = 1
    For i = 1 To UBound(temp)
        splitData = Split(temp(i, 2), ",")

        For j = 0 To UBound(splitData)
            Cells(rw, 2) = temp(i, 1)
            Cells(rw, 3) = splitData(j)
            Cells(rw, 5) = temp(i, 4)
            rw = rw + 1
        Next j
    Next i
End Sub