Using VBA I need to identify multiple merged fields in a worksheet and then apply a formula to the left of each of those merged fields

时间:2016-07-11 20:13:59

标签: excel-vba vba excel

Alright Team, I am hurting here. I have a sheet with 30K row where the name of the call agent is merged between B and M lets say at rows 20 then 45,61,72 so on and so on. I am looking to identify those merged rows in this sheet and then apply a formula in cell A immediately next to the merged cells - the formula reads =RIGHT(Bxx,SEARCH(" ",Bxx,1)-1) (which brings back the agent numbers I need). Lastly I want to carry this agent number down for each cell in column A until it reaches the next agent number. So the result of =RIGHT(B20,SEARCH(" ",B20,1)-1) would carry until it reached the new result for =RIGHT(B45,SEARCH(" ",B45,1)-1).

So far I have only gotten to this point...and it clearly does not work. Any help is greatly apprecaited.

Sub FindMergedFields() 'finds and unmerges merged cells
    Dim rng As Range
    Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "M")).Select
    For Each rng In ActiveSheet.UsedRange
        If rng.MergeCells Then
            'rng.UnMerge
           ' rng.Formula = Right(B, Search(" ", B, 1) - 1)
            Range("B" & (ActiveCell.Row)).Formula = Right(Right(B, Search(" ", B, 1) - 1))
            'Range("h2").Formula = "=IF(B8="""","""",VLOOKUP(B8,'sheet2'!C4:D200,2,FALSE))
        End If
    Next
End Sub 

1 个答案:

答案 0 :(得分:0)

Not sure exactly what the formula is trying to do, but you can put a formula into Column A as follows:

Sub FindMergedFields()
    Dim x As Long, FirstRow As Long, LastRow As Long
    FirstRow = 2 ' Change this to your first data row. I'm assuming Row 1 contains headings and data starts with Row 2.
    ' Finds last row based on contents of Column A (assuming Column A is always populated). Change this if needed.
    LastRow = ActiveSheet.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row
    For x = FirstRow To LastRow
        If Cells(x, 2).MergeCells Then ' Check column B of each row
            Range(Cells(x, "B"), Cells(x, "M")).UnMerge
            Cells(x, 1).Formula = "=RIGHT(B" & x & ",SEARCH("" "",B" & x & ",1)-1)" ' Place formula in Column A
        End If
    Next x
End Sub

As you can see, you don't need to go through all the cells in the used range for columns B-M: just check column B for each one. If it's part of any merged range, it will trigger the "If" clause.

I tried it and it works for me, when B-M are merged. Adjust the formula to suit your purpose.