Смотрите видео ниже, чтобы узнать, как установить наш сайт в качестве веб-приложения на домашнем экране.
Примечание: Эта возможность может быть недоступна в некоторых браузерах.
Для выполнения этой задачи в VBA в Excel, можно использовать следующий скрипт:Напиши скрипт VBA, для введения формулы в excel поиска значений из массива1 в массиве2.
Ячейке присваиваются все найденные значения из массива1 через точку с запятой
Sub Найти_и_присвоить_значения()
Dim массив1 As Range
Dim массив2 As Range
Dim ячейка As Range
Dim найденные_значения As String
Dim значение As Variant
Dim является_найденным As Boolean
Set массив1 = ThisWorkbook.Sheets("Лист1").Range("A1:A10") ' Измените диапазон на свой
Set массив2 = ThisWorkbook.Sheets("Лист1").Range("B1:B10") ' Измените диапазон на свой
For Each ячейка In массив2
найденные_значения = ""
For Each значение In массив1
If значение = ячейка.Value Then
найденные_значения = найденные_значения & значение & "; "
является_найденным = True
End If
Next значение
If является_найденным Then
ячейка.Offset(0, 1).Value = Left(найденные_значения, Len(найденные_значения) - 2)
End If
является_найденным = False
Next ячейка
End Sub
Для создания пользовательской функции в VBA, которая будет выполнять поиск значений из массива1 в массиве2 с возможностью указания точности совпадения, можно использовать следующий код:сделай это функцией в формате =ПОИСКМАССИВ(массив1;массив2;точность), где точность может принимать значение 1 или 0. 1, если нужно примерное совпадение, 0 , если точное.
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As String
Dim значение As Variant
Dim является_найденным As Boolean
Dim критерий As String
найденные_значения = ""
For Each значение In массив2
For Each критерий In массив1
If точность = 1 Then
If InStr(1, значение.Value, критерий.Value) > 0 Then
найденные_значения = найденные_значения & критерий.Value & "; "
является_найденным = True
End If
ElseIf точность = 0 Then
If значение.Value = критерий.Value Then
найденные_значения = найденные_значения & критерий.Value & "; "
является_найденным = True
End If
End If
Next критерий
If является_найденным Then
ПОИСКМАССИВ = Left(найденные_значения, Len(найденные_значения) - 2)
End If
является_найденным = False
Next значение
End Function
=ПОИСКМАССИВ(A1:A10, B1:B10, 1)
для поиска значений из диапазона A1:A10 в диапазоне B1:B10 с примерным совпадением.Извините за ошибку. Давайте попробуем исправить это. Попробуйте следующий код:не работает, выдает ошибку For each control variable must be variant or object
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As String
Dim значение1 As Range
Dim значение2 As Range
Dim является_найденным As Boolean
Dim критерий As String
найденные_значения = ""
For Each значение2 In массив2
For Each значение1 In массив1
If точность = 1 Then
If InStr(1, значение2.Value, значение1.Value) > 0 Then
найденные_значения = найденные_значения & значение1.Value & "; "
является_найденным = True
End If
ElseIf точность = 0 Then
If значение2.Value = значение1.Value Then
найденные_значения = найденные_значения & значение1.Value & "; "
является_найденным = True
End If
End If
Next значение1
If является_найденным Then
ПОИСКМАССИВ = Left(найденные_значения, Len(найденные_значения) - 2)
End If
является_найденным = False
Next значение2
End Function
Для того чтобы исключить дублирующиеся значения из результата функции, можно воспользоваться коллекцией. Вот обновленный код функции:пусть в результате не дублируются значения
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As New Collection
Dim значение1 As Range
Dim значение2 As Range
Dim критерий As String
For Each значение2 In массив2
For Each значение1 In массив1
If точность = 1 Then
If InStr(1, значение2.Value, значение1.Value) > 0 Then
On Error Resume Next
найденные_значения.Add значение1.Value, CStr(значение1.Value)
On Error GoTo 0
End If
ElseIf точность = 0 Then
If значение2.Value = значение1.Value Then
On Error Resume Next
найденные_значения.Add значение1.Value, CStr(значение1.Value)
On Error GoTo 0
End If
End If
Next значение1
Next значение2
Dim результат As String
For Each критерий In найденные_значения
результат = результат & критерий & "; "
Next критерий
If Len(результат) > 0 Then
ПОИСКМАССИВ = Left(результат, Len(результат) - 2)
End If
End Function
Извините за предыдущие ошибки. Давайте попробуем еще раз. Попробуйте следующий обновленный код функции:не работает, выдает ошибку For each control variable must be variant or object
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As New Collection
Dim значение1 As Variant
Dim значение2 As Variant
Dim критерий As String
For Each значение2 In массив2.Value
For Each значение1 In массив1.Value
If точность = 1 Then
If InStr(1, CStr(значение2), CStr(значение1)) > 0 Then
On Error Resume Next
найденные_значения.Add CStr(значение1), CStr(значение1)
On Error GoTo 0
End If
ElseIf точность = 0 Then
If CStr(значение2) = CStr(значение1) Then
On Error Resume Next
найденные_значения.Add CStr(значение1), CStr(значение1)
On Error GoTo 0
End If
End If
Next значение1
Next значение2
Dim результат As String
For Each критерий In найденные_значения
результат = результат & критерий & "; "
Next критерий
If Len(результат) > 0 Then
ПОИСКМАССИВ = Left(результат, Len(результат) - 2)
End If
End Function
{добавь комментарий к функции:
Функция осуществляет поиск значений из массива1 в массиве2
{
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As String
Dim значение1 As Range
Dim значение2 As Range
Dim является_найденным As Boolean
Dim критерий As String
найденные_значения = ""
For Each значение2 In массив2
For Each значение1 In массив1
If точность = 1 Then
If InStr(1, значение2.Value, значение1.Value) > 0 Then
найденныезначения = найденныезначения & значение1.Value & "; "
является_найденным = True
End If
ElseIf точность = 0 Then
If значение2.Value = значение1.Value Then
найденныезначения = найденныезначения & значение1.Value & "; "
является_найденным = True
End If
End If
Next значение1
If является_найденным Then
ПОИСКМАССИВ = Left(найденныезначения, Len(найденныезначения) - 2)
End If
является_найденным = False
Next значение2
End Function
Добавь, чтобы функция была не чувствительна к регистру
Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String
Dim найденные_значения As String
Dim значение1 As Range
Dim значение2 As Range
Dim является_найденным As Boolean
Dim критерий As String
найденные_значения = ""
For Each значение2 In массив2
For Each значение1 In массив1
If точность = 1 Then
If InStr(1, значение2.Value, значение1.Value) > 0 Then
найденные_значения = найденные_значения & значение1.Value & "; "
является_найденным = True
End If
ElseIf точность = 0 Then
If значение2.Value = значение1.Value Then
найденные_значения = найденные_значения & значение1.Value & "; "
является_найденным = True
End If
End If
Next значение1
If является_найденным Then
ПОИСКМАССИВ = Left(найденные_значения, Len(найденные_значения) - 2)
End If
является_найденным = False
Next значение2
End Function
{Код:Function ПОИСКМАССИВ(массив1 As Range, массив2 As Range, точность As Integer) As String Dim найденные_значения As String Dim значение1 As Range Dim значение2 As Range Dim является_найденным As Boolean Dim критерий As String найденные_значения = "" For Each значение2 In массив2 For Each значение1 In массив1 If точность = 1 Then If InStr(1, значение2.Value, значение1.Value) > 0 Then найденные_значения = найденные_значения & значение1.Value & "; " является_найденным = True End If ElseIf точность = 0 Then If значение2.Value = значение1.Value Then найденные_значения = найденные_значения & значение1.Value & "; " является_найденным = True End If End If Next значение1 If является_найденным Then ПОИСКМАССИВ = Left(найденные_значения, Len(найденные_значения) - 2) End If является_найденным = False Next значение2 End Function
Добавь, чтобы функция была не чувствительна к регистру
{добавь не комментарий, а внеси изменения в присланный док