Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск по части переменной - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск по части переменной (Макросы/Sub)
Поиск по части переменной
thrasher Дата: Среда, 22.09.2021, 22:37 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Добрый вечер, друзья.
Есть вопрос. Как по части переменной из массива подставить значение? Например переменная - Новосибирская, а значение проставлялось и по Новосибирску и по Новосибирскому району. Что то типа звёздочек в файнде. Пример во вложении.
Заранее спасибо за помощь.
К сообщению приложен файл: example_1.xlsb(18.1 Kb)


Сообщение отредактировал thrasher - Четверг, 23.09.2021, 00:00
 
Ответить
СообщениеДобрый вечер, друзья.
Есть вопрос. Как по части переменной из массива подставить значение? Например переменная - Новосибирская, а значение проставлялось и по Новосибирску и по Новосибирскому району. Что то типа звёздочек в файнде. Пример во вложении.
Заранее спасибо за помощь.

Автор - thrasher
Дата добавления - 22.09.2021 в 22:37
doober Дата: Среда, 22.09.2021, 23:57 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
Добрый.
Пример где?


 
Ответить
СообщениеДобрый.
Пример где?

Автор - doober
Дата добавления - 22.09.2021 в 23:57
thrasher Дата: Четверг, 23.09.2021, 00:00 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Отредактировал первое сообщение
 
Ответить
СообщениеОтредактировал первое сообщение

Автор - thrasher
Дата добавления - 23.09.2021 в 00:00
doober Дата: Четверг, 23.09.2021, 00:15 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
Как вариант[vba]
Код
Sub Find_Words()
Dim arr As Variant
Last_Column = Sheets("1").UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
Last_Row = Sheets("1").Range("A" & Rows.Count).End(xlUp).Row
arr = Sheets("1").Range("A1").Resize(Last_Row, Last_Column)
For i = 1 To UBound(arr)
    If Len(arr(i, 3)) > 3 Then
       If Right(arr(i, 3), 2) = "ая" Then
       arr(i, 3) = Mid(arr(i, 3), 1, Len(arr(i, 3)) - 2)
       End If
   End If
Next i

Sheets("2").Select
total_rows = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To total_rows
    For j = LBound(arr) To UBound(arr)
        s = InStr(1, Cells(i, 2), arr(j, 3))
        If s Then
            Cells(i, 5) = arr(j, 1)
        End If
    Next j
Next i

End Sub
[/vba]


 
Ответить
СообщениеКак вариант[vba]
Код
Sub Find_Words()
Dim arr As Variant
Last_Column = Sheets("1").UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
Last_Row = Sheets("1").Range("A" & Rows.Count).End(xlUp).Row
arr = Sheets("1").Range("A1").Resize(Last_Row, Last_Column)
For i = 1 To UBound(arr)
    If Len(arr(i, 3)) > 3 Then
       If Right(arr(i, 3), 2) = "ая" Then
       arr(i, 3) = Mid(arr(i, 3), 1, Len(arr(i, 3)) - 2)
       End If
   End If
Next i

Sheets("2").Select
total_rows = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To total_rows
    For j = LBound(arr) To UBound(arr)
        s = InStr(1, Cells(i, 2), arr(j, 3))
        If s Then
            Cells(i, 5) = arr(j, 1)
        End If
    Next j
Next i

End Sub
[/vba]

Автор - doober
Дата добавления - 23.09.2021 в 00:15
thrasher Дата: Четверг, 23.09.2021, 00:48 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
doober, спасибо, в принципе, вариант. Но было бы интересно реализовать поиск вхождения по первым 4-5 буквам, например. Так как если в адресе будет Тюмень, то получившийся "Тюменск", не даст нужного значения.
 
Ответить
Сообщениеdoober, спасибо, в принципе, вариант. Но было бы интересно реализовать поиск вхождения по первым 4-5 буквам, например. Так как если в адресе будет Тюмень, то получившийся "Тюменск", не даст нужного значения.

Автор - thrasher
Дата добавления - 23.09.2021 в 00:48
doober Дата: Четверг, 23.09.2021, 09:43 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
Обрезайте тогда до 4-5 символов[vba]
Код
Sub Find_Words()
Dim arr As Variant
With Sheets("1")
Last_Column = .Cells(1, .Columns.Count).End(xlToLeft).Column
Last_Row = .Range("A" & .Rows.Count).End(xlUp).Row
arr = .Range("A1").Resize(Last_Row, Last_Column + 1)
End With
For i = 1 To UBound(arr)
    If Len(arr(i, 3)) > 5 Then
       arr(i, 4) = Mid(arr(i, 3), 1, 5)
   End If
Next i
Sheets("2").Select
total_rows = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To total_rows
    For j = LBound(arr) To UBound(arr)
        s = InStr(1, Cells(i, 2), arr(j, 3))
        If s Then
            Cells(i, 5) = arr(j, 1)
            Else
            If InStr(1, Cells(i, 2), arr(j, 4)) > 0 And arr(j, 4) <> "" Then
             Cells(i, 5) = arr(j, 1)
            End If
        End If
    Next j
Next i

End Sub
[/vba]


 
Ответить
СообщениеОбрезайте тогда до 4-5 символов[vba]
Код
Sub Find_Words()
Dim arr As Variant
With Sheets("1")
Last_Column = .Cells(1, .Columns.Count).End(xlToLeft).Column
Last_Row = .Range("A" & .Rows.Count).End(xlUp).Row
arr = .Range("A1").Resize(Last_Row, Last_Column + 1)
End With
For i = 1 To UBound(arr)
    If Len(arr(i, 3)) > 5 Then
       arr(i, 4) = Mid(arr(i, 3), 1, 5)
   End If
Next i
Sheets("2").Select
total_rows = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To total_rows
    For j = LBound(arr) To UBound(arr)
        s = InStr(1, Cells(i, 2), arr(j, 3))
        If s Then
            Cells(i, 5) = arr(j, 1)
            Else
            If InStr(1, Cells(i, 2), arr(j, 4)) > 0 And arr(j, 4) <> "" Then
             Cells(i, 5) = arr(j, 1)
            End If
        End If
    Next j
Next i

End Sub
[/vba]

Автор - doober
Дата добавления - 23.09.2021 в 09:43
thrasher Дата: Воскресенье, 26.09.2021, 21:06 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 62
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
doober, спасибо
 
Ответить
Сообщениеdoober, спасибо

Автор - thrasher
Дата добавления - 26.09.2021 в 21:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск по части переменной (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!