Введите пользовательскую функцию в столбец с помощью VBA - PullRequest
Новая
       14

Введите пользовательскую функцию в столбец с помощью VBA

0 голосов
/ 20 декабря 2018

В настоящее время я использую формулу в столбце J листа 2 моей рабочей книги, которая будет искать значения из 5 столбцов на листе 1 и возвращать соответствующий текст.Например, если значение из столбца M на листе 2 совпадает с любым из значений из столбца J на ​​листе 1, оно вернет «N», если нет, оно будет выглядеть в столбце K, и если что-то совпадет там, оно вернет D и т. Д.,Я делаю это в VBA, поэтому используется формула 

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"",""""))))), """")"

. Эта формула работает хорошо и заполняет соответствующие значения.Затем я создал пользовательскую функцию, которая будет искать все значения в столбце J, связанные с идентификационным номером, найденным в столбце C, и разделять их запятыми.Эта функция также хорошо работает при вводе в ячейку.

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

В идеале я хотел бы запустить исходную формулу во всех ячейках столбца J, которая НЕ начинается с Master в столбце A, а затем запустить функцию get_areas ($ C2) во всехячейки, которые действительно начинаются с master в столбце A. Если это невозможно, то я бы хотел запустить функцию get_areas во всех пустых ячейках (то есть они ничего не возвращали из исходной формулы, но все еще имеют формулу вих) в VBA.Я попытался изменить исходную формулу для чтения 

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"","""")))))), """")"

, но получил ошибки о функции get_areas.

1 Ответ

0 голосов
/ 21 декабря 2018

WorksheetFunction.Trim

Все это может не иметь никакого отношения к вашему делу, но может быть полезно в некоторых подобных случаях.Это просто продолжает звучать в моей голове, и вы знаете, как это происходит, когда вы не можете держать рот на замке.

Я написал бы такую ​​функцию: 

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

, которая во всехне так важен, как часть ' WorksheetFunction '.

WorksheetFunction.Trim удаляет все пробелы, кроме одиночных пробелов между словами, тогда как функция Trim VBA удаляет тольколевый и правый пробелы.

Другим наиболее заметным отличием является блок 'If i > 1'.

...