【问题标题】:VBA Fill out all cells between two cellsVBA填写两个单元格之间的所有单元格
【发布时间】:2017-09-22 00:23:40
【问题描述】:

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

这是我所拥有的:

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

因此,如您所见,我希望将中间的所有单元格填充为与两个角单元格相同的值。

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

【问题讨论】:

  • 最初每行只有2个值?
  • 是的,每行总是只有两个值。
  • 循环遍历你的行。在该循环内,循环遍历您的列。如果单元格值不为空,则设置一个等于单元格值的变量并将其写入后续单元格,检查它们是否为空。如果不为空,则退出内循环。
  • 评论更新:在连续遍历单元格之前,检查该行中是否有任何内容(我看到你有空行)。看here(第一段代码)。
  • 我知道它没有被标记为公式,只是为了感兴趣,可以使用公式填充另一张表中的空格。

标签: vba excel


【解决方案1】:

您可以使用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

【讨论】:

  • 天哪!我很好奇:如果连续三个字符,范围可以称为.Areas(1).Areas(2).Areas(3)?我认为你的代码中的几个简短的 cmets 对于像我这样的业余爱好者来说会很棒......
  • 如果每个字符都在不连续的单元格中,那么您实际上会用 .Areas(i) 捕获第 i 个字符。
  • 非常感谢!我印象深刻,真的。
  • @user3598756 :做得很好,一如既往! ;) 我进入了所有循环!^^
  • @R3uK,谢谢。似乎循环更吸引眼球......;-)
【解决方案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

【讨论】:

  • 我为此给 +1,因为它不会在字符相互跟随的特殊(可能是微不足道的!)情况下跌倒。
  • @TomSharpe:谢谢伙计! :)
  • @R3uK 到目前为止,代码工作得很好,唯一的问题是,如果我调用这个模块,让它工作,然后让那个模块调用另一个模块,它将所有单元格复制到另一个工作表中由于某些原因,您的模块填充的列没有被复制。看起来该模块甚至没有工作。但是,如果我在你的模块完成后让它停止,然后手动(通过宏浏览器 Alt + F8)启动下一个模块,它将所有内容复制到另一个工作表中。
猜你喜欢
  • 1970-01-01
  • 2014-12-08
  • 2013-12-03
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多