从工作表复制数据直到条件

Question

我有一个工作表，其中包含 B 列到 D 列中的数据。我想将数据从 B4 复制到前面有空格的单元格值，然后将其粘贴到单独的工作表中，并将工作表更改为值B4，然后它必须复制下一个单元格值，直到前面有空格的单元格值，并继续直到 B 列有空单元格。

除此之外，对于初始阶段没有空格的数据，我必须在 A 列中输入序列号。我已附上输入和预期输出图像供您参考。

输入：

预期输出：

请帮助解决这个问题。

Answer 1

假设您的工作表如下：

在Cell A4中输入以下公式

=IF(LEFT(B4,1)<>" ",COUNTA($A$2:A3)+1-COUNTBLANK($A$2:A3),"")

根据需要拖动/复制公式。

如果您正在寻找 VBA 解决方案，以下应该可行：

Sub Demo()
    Dim ws As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim rng As Range

    index = 1
    Set ws = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    lastRow = ws.Cells(Rows.count, "B").End(xlUp).Row
    Set rng = ws.Range("B4:B" & lastRow)
    For i = 4 To lastRow
        If Left(ws.Cells(i, 2).Value, 1) <> " " Then
            ws.Cells(i, 1).Value = index
            index = index + 1
        End If
    Next i
End Sub

_______________________________________________________________________________

EDIT 1：首先将数据从Sheet1复制到Sheet2，然后添加序列号。

Sub Demo()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim rng As Range

    index = 1
    Set ws1 = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    lastRow = ws1.Cells(Rows.count, "B").End(xlUp).Row
    ws1.Range("B2:D" & lastRow).Copy Destination:=ws2.Range("B2")
    Set rng = ws2.Range("B4:B" & lastRow)
    For i = 4 To lastRow
        If Left(ws2.Cells(i, 2).Value, 1) <> " " Then
            ws2.Cells(i, 1).Value = index
            index = index + 1
        End If
    Next i
End Sub

_______________________________________________________________________________

编辑 2：

Sub Demo()
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, index As Long, i As Long
    Dim copyRng As Range, rng1 As Range, rng2 As Range

    index = 1
    Set srcWS = ThisWorkbook.Sheets("Sheet1")   '---->change the sheet name as required
    lastRow = srcWS.Cells(Rows.count, "B").End(xlUp).Row
    Set rng1 = srcWS.Cells(4, 2)
    For i = 4 To lastRow
        If Left(srcWS.Cells(i, 2).Value, 1) <> " " Then
            srcWS.Cells(i, 1).Value = index
            index = index + 1
            If i <> 4 Then
                Set rng2 = srcWS.Cells(i - 1, 4)
                Set destWS = Sheets.Add(After:=Sheets(Sheets.count))
                srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4")
                Set rng1 = srcWS.Cells(i, 2)
            End If
        End If
    Next i
    Set rng2 = srcWS.Cells(lastRow, 4)

    Set destWS = Sheets.Add(After:=Sheets(Sheets.count))
    srcWS.Range(rng1, rng2).Copy Destination:=destWS.Range("B4")

End Sub