我希望你能提供帮助。我在下面有一段代码,它的工作有点。我只是需要它做更多。
它目前沿着从A1到H1的第一行。如果找到空白单元格,则将单元格值复制到空白单元格的左侧,然后将此值粘贴到空白单元格中,然后移动。
由于范围可以从一天到一天A1变为H1是不够的。我现在需要代码查看第一行,直到找到包含数据的最后一个单元格,然后查找空白并开始复制和粘贴过程。
我还需要代码然后在粘贴的单元格中添加2,以便我可以执行一个轴,并区分复制的单元格和粘贴的单元格。
为了更好地理解,我在下面提供了一张图片。最终结果应该是单元格B2包含文本 24 - 公司:Hier 2 ,E2包含文本 07 - 产品:Family Hier 2 < / EM>
我的代码如下所示,我们非常感谢所有帮助。
图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
答案 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