Question

我有一个数据集，A列有一些空单元格。如果有一个空单元格，我想将列B中的值移动到上面的行，并清除B列中的值。当A列中只有一个空单元格时，我想出了一个代码来执行此操作但是当A列中有两个或更多空单元格时它不起作用（我的意思是将B列中的值移动到A列不为空的行;在这种情况下不是上面的行）。任何人都可以帮我调整代码，以便它可以在其他情况下工作吗？谢谢。

我的代码如下：

Sub MoveToRow()
Dim i As Integer
For i = 1 To 10


If IsEmpty(Sheets("Sheet1").Range("A" & i)) = True Then
    Sheets("Sheet1").Range("B" & i).Offset(-1, 0) = Range("B" & i).Offset(-1, 0) & "/" & Range("B" & i)
    Sheets("Sheet1").Range("B" & i).Value = Empty

End If

Next i

End Sub

数据集-之前

Sunday  work1
        work2
Monday  work3
Tuesday work4
        work5
Wednesday   work6
Thursday    work7
Friday  work8

数据集-后

Sunday  work1/work2

Monday  work3
Tuesday work4/work5

Wednesday   work6
Thursday    work7
Friday  work8

数据集 - 没有用（因为星期日下面有两个空单元格）

Sunday  work1  
        work2
        work3
Monday  work4
Tuesday work5 
        work6
Wednesday   work7
Thursday    work8
Friday  work9

数据集 - 如果有效

Sunday  work1/work2/work3  


Monday  work4
Tuesday work5/work6 

Wednesday   work7
Thursday    work8
Friday  work9

Answer 1

尝试一下：

Option Explicit

Sub MoveToRow()

Dim i As Integer
Dim ws As Worksheet
Dim r As Range
Dim count As Integer

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
For Each r In ws.Range(Cells(1, 1), Cells(Rows.count, 1).End(xlUp))
    If IsEmpty(r) Then
        count = count + 1
        With ws.Range(r.address)
            .Offset(-count, 1) = .Offset(-count, 1) & "/" & .Offset(0, 1)
            .Offset(0, 1).ClearContents
        End With
    Else
        count = 0
    End If
Next r

Application.ScreenUpdating = True

End Sub

如果您愿意，还可以在其中添加一些代码以删除左侧空行。但我会把这件事留给你做。： - ）

如果单元格为空，则将相邻列的值移动到上面的行

1 个答案: