В столбец D необходимо записать значение из массива (TQX, LQM и так далее) если строка содержит элемент массива.
Не могу понять, как написать цикл, чтобы он перебирал все строки в столбце E и искал в них один из элементов массива. При нахождении элемента в ячейку D заносил найденый элемент массива. Ну и при отсутствии такового записывал в ячейку D пометку, что нет совпадений.
Dim sStr As String sStr = myArray(0) pStr = Range("E" & i + 1) If InStr(1, pStr, sStr, vbTextCompare) > 0 Then ActiveCell.FormulaR1C1 = myArray(0) Else ActiveCell.FormulaR1C1 = "----------!" End If ActiveCell.Offset(1, 0).Select Next
End Sub
[/vba] [moder]Оформляйте коды тегами. Это такие кнопочки с картинками немного выше того поля, где Вы пишете сообщение.
Прошу не ругаться и помидорами не кидаться..... Я новичок...
В столбец D необходимо записать значение из массива (TQX, LQM и так далее) если строка содержит элемент массива.
Не могу понять, как написать цикл, чтобы он перебирал все строки в столбце E и искал в них один из элементов массива. При нахождении элемента в ячейку D заносил найденый элемент массива. Ну и при отсутствии такового записывал в ячейку D пометку, что нет совпадений.
Dim sStr As String sStr = myArray(0) pStr = Range("E" & i + 1) If InStr(1, pStr, sStr, vbTextCompare) > 0 Then ActiveCell.FormulaR1C1 = myArray(0) Else ActiveCell.FormulaR1C1 = "----------!" End If ActiveCell.Offset(1, 0).Select Next
End Sub
[/vba] [moder]Оформляйте коды тегами. Это такие кнопочки с картинками немного выше того поля, где Вы пишете сообщение.adventurerodnako
Sub Arr() Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value myArray = Array("TQX", "NS3", "LQM", "ND2", "LDG", "LBES", "FDGS", _ "TMRS", "TRC", "LWC", "LBE", "NS2", "TOM", "TDX", "LWX", "LDM") For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутсвует!" Next i Range("D1").Resize(i - 1).Value = x End Sub
Помидоры уже кончились... А вот тыквы - самый сезон :)[/offtop]
Можно попробовать так: [vba]
Код
Sub Arr() Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value myArray = Array("TQX", "NS3", "LQM", "ND2", "LDG", "LBES", "FDGS", _ "TMRS", "TRC", "LWC", "LBE", "NS2", "TOM", "TDX", "LWX", "LDM") For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутсвует!" Next i Range("D1").Resize(i - 1).Value = x End Sub
[offtop]Ребята, подскажите, пожалуйста, где доступным языком написано о массивах в вба? Хоть убей не могу разобраться =\ PS: Желательно с практическими примерами..
[offtop]Ребята, подскажите, пожалуйста, где доступным языком написано о массивах в вба? Хоть убей не могу разобраться =\ PS: Желательно с практическими примерами..SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Четверг, 03.10.2013, 10:17
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
myArray = Array("TQX", "NS3", "LQM", "ND2", "LDG", "LBES", "FDGS", _ "TMRS", "TRC", "LWC", "LBE", "NS2", "TOM", "TDX", "LWX", "LDM", "LSX") For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
End Sub
[/vba]
А вот так нет:
[vba]
Код
Sub Arr()
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With
For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
End Sub
[/vba]
выдаёт ошибку -- Run-time error '9': Subscript out of range.
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
myArray = Array("TQX", "NS3", "LQM", "ND2", "LDG", "LBES", "FDGS", _ "TMRS", "TRC", "LWC", "LBE", "NS2", "TOM", "TDX", "LWX", "LDM", "LSX") For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
End Sub
[/vba]
А вот так нет:
[vba]
Код
Sub Arr()
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With
For i = 2 To UBound(x) For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
End Sub
[/vba]
выдаёт ошибку -- Run-time error '9': Subscript out of range.adventurerodnako
x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With For i = 2 To UBound(x) For j = 1 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
End Sub
[/vba]
Поменял j =0 на 1 и работает [vba]
Код
Sub Arr() Dim x, i&, j&, myArray As Variant
x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With For i = 2 To UBound(x) For j = 1 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
чтобы не заморачиваться, для обоих вариантов подойдет так:
Работает!!!
[vba]
Код
Sub Arr()
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With
For i = 2 To UBound(x) For j = LBound(myArray) To UBound(myArray) 'For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
чтобы не заморачиваться, для обоих вариантов подойдет так:
Работает!!!
[vba]
Код
Sub Arr()
Dim x, i&, j&, myArray As Variant x = Range("E1", Cells(Rows.Count, 5).End(xlUp)).Value
With WorksheetFunction myArray = .Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value) End With
For i = 2 To UBound(x) For j = LBound(myArray) To UBound(myArray) 'For j = 0 To UBound(myArray) If InStr(x(i, 1), myArray(j)) > 0 Then x(i, 1) = myArray(j): Exit For Next j If j > UBound(myArray) Then x(i, 1) = "отсутствует!" Next i Range("D1").Resize(i - 1).Value = x
Массив, получаемый из диапазона листа всегда двумерный, в соответствии с адресом ячейки (строка, столбец). Переводить ли его в одномерный? Дело вкуса и задачи.
Массив, получаемый из диапазона листа всегда двумерный, в соответствии с адресом ячейки (строка, столбец). Переводить ли его в одномерный? Дело вкуса и задачи.RAN
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Но вот в каком месте?
:( 
