Enter User Defined Function into Column Using VBA

2019-08-27 22:00发布

问题:

I currently am using a formula in Column J of Sheet 2 of my workbook that will look up values from 5 columns on Sheet 1 and return the corresponding text. For example if the value from column M on Sheet 2 matches any of the values from column J on Sheet 1 it would return "N", if not it would look in column K and if matched anything there it would return D, and so on. I am doing this in VBA so the formula used is

ActiveSheet.Range("J2:J" & intLastRow).FormulaR1C1 = _
    "=IFERROR(IF(ISNUMBER(MATCH(RC[3],Sheet1!C10,0)),""N"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C11,0)),""D"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C12,0)),""R"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C13,0)),""G"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C14,0)),""F"",""""))))), """")"

This formula works well and fills in the corresponding values. I then created a user defined function that will look up all of the values in column J that are associated with an ID number found in column C and separate them by commas. This function also works well when entered into a cell.

Function get_areas(ID As String) As String
Dim rng As Range, cel As Range

Set rng = Range("A2:A" & Cells(rows.count,1).End(xlUp).Row)

Dim areas As String
For Each cel In rng
If IsNumeric(Left(cel, 1)) And cel.Offset(0, 2) = ID Then
    If InStr(1, areas, cel.Offset(0, 9)) = 0 Then
        areas = cel.Offset(0, 9) & ", " & areas
    End If
End If
Next cel

areas = Trim(Left(areas, Len(areas) - 2))
get_areas = areas
End Function

Ideally, what I would like to do is run the original formula in all cells in column J that DON'T start with Master in Column A and then run the get_areas($C2) function in all cells that DO start with master in Column A. If that is not feasible, then I would like to run the get_areas function in all cells that are blank (meaning they didn't return anything from the original formula, but still have the formula in them) in VBA. I have tried modifying the original formula to read

ActiveSheet.Range("J2:J" & intLastRow).FormulaR1C1 = 
"=IFERROR(IF(LEFT(RC[-9],6)=""master"", get_areas(RC[-7]),             
IF(ISNUMBER(MATCH(RC[3],Sheet1!C10,0)),""N"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C11,0)),""D"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C12,0)),""R"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C13,0)),""G"", 
IF(ISNUMBER(MATCH(RC[3],Sheet1!C14,0)),""F"","""")))))), """")"

but received errors about the get_areas function.

回答1:

WorksheetFunction.Trim

All of this might have nothing to do with your case but might be useful in some similar cases. It just keeps ringing in my head and you know how it is when you can't keep your mouth shut.

I would have written the function like this:

Function get_areas(ID As String) As String

Dim rng As Range
Dim i As Long
Dim areas As String

Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

With rng
    For i = 1 To .Cells.Count
        If IsNumeric(Left(.Cells(i, 1))) And .Cells(i, 1).Offset(0, 2) = ID Then
            If InStr(1, areas, .Cells(i, 1).Offset(0, 9)) = 0 Then
                If i > 1 Then
                    areas = areas & ", " & .Cells(i, 1).Offset(0, 9)
                  Else
                    areas = .Cells(i, 1).Offset(0, 9)
                End If
            End If
        End If
    Next
End With

get_areas = WorksheetFunction.Trim(areas)

End Function

which in all is not so important as the 'WorksheetFunction' part.

WorksheetFunction.Trim removes all spaces except single spaces between words, while VBA's Trim function only removes the left and right spaces.

The other most noticeable difference is the 'If i > 1' block.