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

时间:2017-03-17 11:27:02

标签: excel vba excel-vba

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

这就是我所拥有的:

What I currently have

我希望代码能够像这样填写其间的所有单元格:

What I need

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

非常感谢任何帮助!提前谢谢。

2 个答案:

答案 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