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

<强> _______________________________________________________________________________

编辑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

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

1 个答案: