VBA在列标题中查找空白单元格

Question

希望你能帮上忙。我在下面有一段代码，它有点工作。我只是需要它做更多的事情。

它目前沿着从 A1 到 H1 的第一行。如果它找到一个空白单元格，则将单元格值复制到空白单元格的左侧，然后将此值粘贴到空白单元格中，然后继续移动。

由于范围每天都在变化，因此 A1 到 H1 是不够的。我现在需要代码沿着第一行查看，直到找到最后一个包含数据的单元格，然后查找空白并开始复制和粘贴过程。

我还需要代码，然后将 2 添加到粘贴的单元格，以便我可以执行透视并区分复制的单元格和粘贴的单元格。

我在下面提供了一张图片以便更好地理解。最终结果应该是单元格 B2 包含文本 24 - Company: Hier 2 并且 E2 包含文本 07 - Product: Family Hier 2

我的代码如下，我们非常感谢任何和所有帮助。

图 1

我的代码

Public Sub BorderForNonEmpty()
    Dim myRange As Range
    Set myRange = Sheet1.Range("A1:H1")
    For Each MyCell In myRange
        If MyCell.Text = "" Then
            MyCell.Offset(0, -1).Select
        ActiveCell.Copy
        ActiveCell.Offset(0, 1).PasteSpecial (xlPasteAll)
        End If
    Next
End Sub

Answer 1

试试下面的代码 - cmets 指示每个重要的行在做什么：

Option Explicit

Sub FillInHeaders()

    Dim ws As Worksheet
    Dim lngRowWithHeaders As Long
    Dim rngHeader As Range
    Dim rngCell As Range

    ' get a reference to your worksheet
    Set ws = ThisWorkbook.Worksheets("SHeet1")

    ' set the row that the headers are on
    lngRowWithHeaders = 2

    ' get the range from A1 to ??1 where ?? is last column
    Set rngHeader = ws.Cells(lngRowWithHeaders, 1) _
        .Resize(1, ws.Cells(lngRowWithHeaders, ws.Columns.Count) _
        .End(xlToLeft).Column)

    ' iterate the range and look for blanks
    For Each rngCell In rngHeader
        ' if blank then ...
        If IsEmpty(rngCell.Value) Then
            ' get cell value from left and a 2
            rngCell.Value = rngCell.Offset(0, -1).Value & "2"
        End If
    Next rngCell

End Sub