VBA填写两个单元格之间的所有单元格

我目前正在尝试写一些VBA代码,将用两个单元格的值填充两个单元格之间的所有单元格。

这是我有什么:

我现在有什么

我想代码填写所有这样的单元格:

我需要的

所以,正如你所看到的,我希望所有的单元之间填充与两个angular单元相同的值。

很感谢任何forms的帮助! 提前致谢。

放置在一个新的模块并运行test_DTodor

 Option Explicit Sub test_DTodor() Dim wS As Worksheet Dim LastRow As Double Dim LastCol As Double Dim i As Double Dim j As Double Dim k As Double Dim RowVal As String Set wS = ThisWorkbook.Sheets("Sheet1") LastRow = LastRow_1(wS) LastCol = LastCol_1(wS) For i = 1 To LastRow For j = 1 To LastCol With wS If .Cells(i, j) <> vbNullString Then '1st value of the row found RowVal = .Cells(i, j).Value k = 1 'Fill until next value of that row Do While j + k <= LastCol And .Cells(i, j + k) = vbNullString .Cells(i, j + k).Value = RowVal k = k + 1 Loop 'Go to next row Exit For Else End If End With 'wS Next j Next i End Sub Public Function LastCol_1(wS As Worksheet) As Double With wS If Application.WorksheetFunction.CountA(.Cells) <> 0 Then LastCol_1 = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column Else LastCol_1 = 1 End If End With End Function Public Function LastRow_1(wS As Worksheet) As Double With wS If Application.WorksheetFunction.CountA(.Cells) <> 0 Then LastRow_1 = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else LastRow_1 = 1 End If End With End Function 

你可以使用Range对象的SpecialCells()方法:

 Sub main() Dim cell As Range For Each cell In Intersect(Columns(1), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).EntireRow) With cell.EntireRow.SpecialCells(xlCellTypeConstants) Range(.Areas(1), .Areas(2)).Value = .Areas(1).Value End With Next End Sub