我目前正在尝试编写一些VBA代码,它将使用两个单元格的值填充两个单元格之间的所有单元格。
这就是我所拥有的:
我希望代码能够像这样填写其间的所有单元格:
所以,正如你所看到的,我希望中间的所有单元格都填充与两个角单元相同的值。
非常感谢任何帮助!提前谢谢。
答案 0 :(得分:5)
您可以使用SpecialCells()
对象的Range
方法:
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
答案 1 :(得分:2)
将其放入新模块并运行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