需要循环一个公式,直到最后一列

时间:2016-03-22 17:20:27

标签: excel vba excel-vba loops

我环顾四周但找不到完全符合我需要的功能。我基本上做了一个替换,但只在带有X的单元格上,并替换为它自己的标题的值

Columns("B:B").Select
Selection.Replace What:="X", Replacement:="=B2", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("C:C").Select
Selection.Replace What:="X", Replacement:="=C2", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("D:D").Select
Selection.Replace What:="X", Replacement:="=D2", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

这一直持续到最后一列为止。在这种情况下,它是CD。这显然是非常不切实际的,并且是一种循环的方法,其中Replacement:=“= B2”的值将在每次传递中上升一列值将是理想的。

2 个答案:

答案 0 :(得分:2)

我认为第2行是你应该看到的范围,因为这是Range.Replace method中转移的内容。

Sub X_to_HDR()
    Dim c As Long
    With Worksheets("sheet1")
        With .Cells(2, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
                For c = 1 To .Columns.Count
                    With .Columns(c)
                        .Replace What:="X", Replacement:=Chr(61) & .Parent.Cells(2, c + 1).Address(0, 0), _
                                 LookAt:=xlWhole, MatchCase:=False
                    End With
                Next c
            End With
        End With
    End With
End Sub

我已将 xlPart 更改为 xlWhole ;如果您认为原件更合适,请将其更改回来。

答案 1 :(得分:1)

这是一个循环,可以根据您的描述为您提供所需的信息:

Sub LoopColumns()

Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1") 'chnage as needed

Dim rColumns As Range, rCell As Range
Set rColumns = ws1.Range(ws1.Range("B2"), ws1.Range("B2").End(xlToRight)) ' asssumes contiguous range of headers

For Each rCell In rColumns

    rCell.EntireColumn.Replace What:="X", Replacement:=rCell.Value2, LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Next

End Sub