简体   繁体   中英

Need to loop a formula increasing until last column

I looked around but can't find quite exactly a function that does what I need. I am basically doing a find a replace but only on cells with an X and replacing with the value of it's own header

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

This continues all the way until whatever the last column is. In this case it is CD. This is incredibly impractical obviously and a way to loop this, where the value for Replacement:="=B2" would just go up by a column value on each pass would be ideal.

Here's a loop that should get you what you need based on your description:

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

I think that row 2 is one that you should base the extent upon seeing as that is what gets transferred in the 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

I've changed your xlPart to xlWhole ; change this back if you feel the original was more appropriate.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM