Question

前段时间我在这里发了similar question并得到了很好的答案。但现在我需要稍微修改一下代码，但我无法改变它。

在Excel工作表中，我的单元格具有值，但这两个单元格之间的所有单元格都是空的。我希望Excel用第三个单元格的值填充它们之间的空单元格。想象：

这就是它的样子

现在我希望宏用相应的J单元格的值填充所有空单元格。所以它看起来像这样：

从上一个帖子中我使用了这段代码：

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

是否可以更改现有代码？或者也许是我以前的链接问题中的其他代码？我调查了两个，但遗憾的是我自己没能。

感谢任何帮助。提前谢谢。

Answer 1

使用您的其他问题中的代码，但更改rowval以查看第J列

    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, 10).Value --This is all I changed
                    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

Answer 2

回答修改以前的代码

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).Offset(, 1), .Areas(2).Offset(, -1)).Value = Cells(.Areas(1).Row, "J").Value
    End With
Next
End Sub

Answer 3

假设每行中有三个值并且它们不是连续的，那么对原始代码进行少量更改就足够了。

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).Offset(, 1), .Areas(2).Offset(, -1)).Value = .Areas(3).Value
    End With
Next

End Sub

Answer 4

这将完全符合你想要的三行

Sub FillBlanks()
    Dim c
    For Each c In ActiveSheet.UsedRange.Columns("J").SpecialCells(xlCellTypeConstants)
        Range(c.Offset(0, c.End(xlToLeft).Column - c.Column), c.Offset(0, -c.Column + 1)).SpecialCells(xlCellTypeBlanks).Value2 = c.Value2
    Next c
End Sub

VBA Excel - 使用第三个单元格的值填充两个单元格之间的空格

4 个答案: