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

时间:2017-04-05 11:54:58

标签: excel vba excel-vba copy-paste

我希望你能提供帮助。我在下面有一段代码,它的工作有点。我只是需要它做更多。

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

由于范围可以从一天到一天A1变为H1是不够的。我现在需要代码查看第一行,直到找到包含数据的最后一个单元格,然后查找空白并开始复制和粘贴过程。

我还需要代码然后在粘贴的单元格中添加2,以便我可以执行一个轴,并区分复制的单元格和粘贴的单元格。

为了更好地理解,我在下面提供了一张图片。最终结果应该是单元格B2包含文本 24 - 公司:Hier 2 ,E2包含文本 07 - 产品:Family Hier 2 < / EM>

我的代码如下所示,我们非常感谢所有帮助。

图1

enter image description here

我的代码

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

1 个答案:

答案 0 :(得分:2)

尝试下面的代码 - 注释表明每条重要的行正在做什么:

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