首页 文章

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

提问于
浏览
0

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

除此之外,我必须在A列中输入序列号,而不是在初始阶段没有空格的数据 . 我已附加输入和预期输出图像供您参考 .

输入:
enter image description here

预期产量:

enter image description here

请帮忙解决这个问题 .

1 回答

  • 1

    假设您的表格如下:

    enter image description here

    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
    

    _______________________________________________________________________________

    EDIT 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
    

相关问题