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

我是VBA的新用户，正在尝试以下操作（我被卡在最后）：

我需要find列C到P（3到16）的每一行的第一个空单元格，取这个值，并粘贴到同一行的B列。

我试图做的是：

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

第一部分工作正常，但我不太清楚如何复制同一行中的第一个非空单元格。 我想如果可以这样做，我可能不需要第一步。 希望对此有任何build议/帮助。 有这样的代码：

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 。

我也不build议使用xlUp或xlDown或xlCellTypeLastCell因为这些并不总是返回您所期望的结果，因为这些单元格的元数据是在保存文件时创build的，所以您在文件保存后所做的任何更改在重新保存之前可以给你错误的单元格。 这可以使debugging成为一场噩梦。 相反，我build议使用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