Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Как извлеч дату из ячейки масива и вставить в другую ячейку автоматически
 
Код
Public Function RegExpExtract(Text As String, Pattern As String, Optional Item As Integer = 1) As String
    On Error GoTo ErrHandl
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = Pattern
    regex.Global = True
    If regex.test(Text) Then
        Set matches = regex.Execute(Text)
        RegExpExtract = matches.Item(Item - 1)
        Exit Function
    End If
ErrHandl:
    RegExpExtract = CVErr(xlErrValue)
End Function

Попробуйте через регулярное выражение.
Код
=RegExpExtract(B2;"\d{2}\.\d{2}\.\d{2}")
Изменено: Umida - 6 Фев 2019 17:56:08
Нежелательный пересчет текущего листа при работе функции FuzzyVLOOKUP
 
Спасибо!
Нежелательный пересчет текущего листа при работе функции FuzzyVLOOKUP
 
Нет ли другого варианта? Спасибо.

Цитата
а после конца макроса включать обратно.
Как именно, подскажите.
Нежелательный пересчет текущего листа при работе функции FuzzyVLOOKUP
 
Здравствуйте!
После вставки функции FuzzyVLOOKUP, каждый раз когда фильтрую данные или удаляю строки идет пересчет листа, и это тормозит работу. Как можно ускорить работы функции FuzzyVLOOKUP.
Можно ли дописать макрос?

Код
Public Function FuzzyVLOOKUP(Искомое_Значение As Range, Словарь As Range, Значение_или_индекс As Boolean, Optional Процент_совпадения As Long = 50, Optional Минимальная_длина_слова As Long = 0, Optional Слова_исключения As String = "")
    Dim x As Long
    Dim y As Double
    Dim Score As Double
    Dim min As Double
    Dim Max As Long
    Dim max2 As Long
    Dim d As Long
    For x = 1 To Словарь.Count
        Score = SringCompare(Искомое_Значение.Value, Словарь(x).Value, 50, Минимальная_длина_слова, Слова_исключения, Max)
        Score = Score + SringCompare(Словарь(x).Value, Искомое_Значение.Value, 50, Минимальная_длина_слова, Слова_исключения, max2)
        'If min > Score Then min = Score
        'If Max < Score Then Max = Score
        If Score > y Then
            y = Score

            If Значение_или_индекс = False Then
                d = max2
'Debug.Print Score / ((Max + d) * 100)
                If Score / ((Max + d) * 100) >= (Процент_совпадения / 100) Then

                    FuzzyVLOOKUP = Словарь(x).Value

                Else: FuzzyVLOOKUP = "Нет совпадений"
                End If
            End If
            If Значение_или_индекс = True Then
                d = max2
                'Debug.Print rngWith(x).Value
                FuzzyVLOOKUP = Score / ((Max + d) * 100)
            End If
        End If

    Next x
    
End Function
Поиск данных по нескольким признакам, Нужно найти данные по нескольким признакам среди повторяющихся значений
 
Код
=ВПР3(Факт!$A$2:$A$34;A2;Факт!$B$2:$B$34;B2;Факт!$B$2:$B$34)


Код
Function ВПР3(Table1 As Range, SearchValue1 As Variant, Table2 As Range, SearchValue2 As Variant, _
ResultColumn As Range)
        Dim i As Integer
        For i = 1 To Table1.Rows.Count
                If Table1.Cells(i, 1) = SearchValue1 Then
                If Table2.Cells(i, 1) = SearchValue2 Then
                ВПР3 = ResultColumn.Cells(i, 1)
                    Exit For
                    End If
                End If
                Next i
    End Function
Изменено: Umida - 5 Янв 2019 20:31:16
Не работает переводчик на ленте
 
Здравствуйте.
Не работает функционал перевести на ленте Рецензирование вкладка язык. Как можно включить его. Спасибо
Изменено: Umida - 28 Дек 2018 15:39:14
Страницы: 1
Наверх