Question

我是VBA的新用户，我正在尝试执行以下操作（我坚持到最后）：

我需要在从C列到P（3到16）的每一行中找到第一个空单元格，取这个值，然后将其粘贴到同一行的B列中。

我尝试做的是：

在C列中查找非空单元格，将这些值复制到B列。
然后在B列中搜索空单元格，并尝试复制该行中的第一个非空单元格。

第一部分很好，但我不太确定如何复制同一行中的第一个非空单元格。我想如果能做到这一点，我可能不需要第一步。将不胜感激任何建议/帮助。有代码：

Private Sub Test()

For j = 3 To 16
For i = 2 To 186313
    If Not IsEmpty(Cells(i, j)) Then
        Cells(i, j - 1) = Cells(i, j)

            End If
sourceCol = 2

'column b has a value of 2
RowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

'for every row, find the first blank cell, copy the first not empty value in that row
For currentRow = 1 To RowCount
    currentRowValue = Cells(currentRow, sourceCol).Value
    If Not IsEmpty(Cells(i, 3)) Or Not IsEmpty(Cells(i, 4)) Or Not IsEmpty(Cells(i, 5)) Or Not IsEmpty(Cells(i, 6)) Then
    Paste

~ got stuck here

        Next i
    Next j
End Sub

Answer 1

你的循环效率非常低，因为它在数百万个单元格上进行迭代，其中大多数单元格都不需要查看。 (16-3)*(186313-2)=2,422,043。

我也不建议使用xlUp或xlDown或xlCellTypeLastCell，因为这些并不总是返回您期望的结果，因为这些单元格的元数据是在文件已保存，因此在保存文件之后但在重新保存文件之前所做的任何更改都会导致错误的单元格。这可以使调试成为一场噩梦。相反，我建议使用Find()方法查找最后一个单元格。这是快速和可靠的。

我可能会这样做。我在这里循环使用最少量的细胞，这将加快速度。

您可能还希望禁用应用程序的screenupdating属性以加快速度并使整个事物看起来更加无缝。

最后，如果您是VBA的新手，最好养成禁用enableevents属性的习惯，这样如果您目前拥有或将来添加任何事件监听器，您将不会触发与它们相关的程序不必要地或甚至不合需要地运行。

Option Explicit

Private Sub Test()
    Dim LastUsed As Range
    Dim PasteHere As Range
    Dim i As Integer

    Application.ScreenUpdating=False
    Application.EnableEvents=False

    With Range("B:B")
        Set PasteHere = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False, False)
        If PasteHere Is Nothing Then Set PasteHere = .Cells(1, 1) Else: Set PasteHere = PasteHere.Offset(1)
    End With
    For i = 3 To 16
        Set LastUsed = Cells(1, i).EntireColumn.Find("*", Cells(1, i), xlFormulas, xlPart, xlByRows, xlPrevious, False, False, False)
        If Not LastUsed Is Nothing Then
            LastUsed.Copy Destination:=PasteHere
            Set PasteHere = PasteHere.Offset(1)
        End If
        Set LastUsed = Nothing
    Next

    Application.ScreenUpdating=True
    Application.EnableEvents=True
End Sub

Answer 2

Sub non_empty()
Dim lstrow As Long
Dim i As Long
Dim sht As Worksheet

Set sht = Worksheets("Sheet1")
lstrow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For i = 1 To lstrow
   If IsEmpty(Range("B" & i)) Then
      Range("B" & i).Value = Range("B" & i).End(xlToRight).Value
   End If
Next i

End Sub

VBA：复制同一行中的第一个空单元格

2 个答案: