В моём макросе все найденные значения выводятся в ячейку С4 через запятую, а мне необходимо чтобы каждое значение выводилось в новую ячейку, например С4, С5, С6 и т.д.
[vba]
Код
Sub Поиск() Dim searchValue As String Dim cell As Range Dim result As String Dim searchRange As Range
' Получаем значение для поиска из ячейки B1 searchValue = ThisWorkbook.Sheets("Лист1").Range("B1").Value
' Указываем диапазон для поиска Set searchRange = ThisWorkbook.Sheets("Лист1").Range("A1:A20")
' Инициализируем переменную для хранения результата result = ""
' Проходим по каждой ячейке в указанном диапазоне For Each cell In searchRange If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then ' Если найдено совпадение, добавляем значение в результат result = result & cell.Value & ", " End If Next cell
' Удаляем последнюю запятую и пробел, если есть совпадения If Len(result) > 0 Then result = Left(result, Len(result) - 2) End If
' Выводим найденные значения в ячейку C4 ThisWorkbook.Sheets("Лист1").Range("C4").Value = result End Sub
[/vba]
В моём макросе все найденные значения выводятся в ячейку С4 через запятую, а мне необходимо чтобы каждое значение выводилось в новую ячейку, например С4, С5, С6 и т.д.
[vba]
Код
Sub Поиск() Dim searchValue As String Dim cell As Range Dim result As String Dim searchRange As Range
' Получаем значение для поиска из ячейки B1 searchValue = ThisWorkbook.Sheets("Лист1").Range("B1").Value
' Указываем диапазон для поиска Set searchRange = ThisWorkbook.Sheets("Лист1").Range("A1:A20")
' Инициализируем переменную для хранения результата result = ""
' Проходим по каждой ячейке в указанном диапазоне For Each cell In searchRange If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then ' Если найдено совпадение, добавляем значение в результат result = result & cell.Value & ", " End If Next cell
' Удаляем последнюю запятую и пробел, если есть совпадения If Len(result) > 0 Then result = Left(result, Len(result) - 2) End If
' Выводим найденные значения в ячейку C4 ThisWorkbook.Sheets("Лист1").Range("C4").Value = result End Sub
Sub Поиск() Dim searchValue As String Dim cell As Range, out(), ct& Dim result As String Dim searchRange As Range
' Получаем значение для поиска из ячейки B1 searchValue = ThisWorkbook.Sheets("Лист1").Range("B1").Value
' Указываем диапазон для поиска Set searchRange = ThisWorkbook.Sheets("Лист1").Range("A1:A20") ReDim out(1 To searchRange.Rows.Count, 1 To 1)
' Инициализируем переменную для хранения результата result = ""
' Проходим по каждой ячейке в указанном диапазоне For Each cell In searchRange If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then ' Если найдено совпадение, добавляем значение в результат ct = ct + 1 out(ct, 1) = cell.Value End If Next cell
' Выводим найденные значения в ячейку C4 If ct > 0 Then ThisWorkbook.Sheets("Лист1").Range("C4").Resize(ct, 1) = out End If End Sub
[/vba]
Где то так[vba]
Код
Sub Поиск() Dim searchValue As String Dim cell As Range, out(), ct& Dim result As String Dim searchRange As Range
' Получаем значение для поиска из ячейки B1 searchValue = ThisWorkbook.Sheets("Лист1").Range("B1").Value
' Указываем диапазон для поиска Set searchRange = ThisWorkbook.Sheets("Лист1").Range("A1:A20") ReDim out(1 To searchRange.Rows.Count, 1 To 1)
' Инициализируем переменную для хранения результата result = ""
' Проходим по каждой ячейке в указанном диапазоне For Each cell In searchRange If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then ' Если найдено совпадение, добавляем значение в результат ct = ct + 1 out(ct, 1) = cell.Value End If Next cell
' Выводим найденные значения в ячейку C4 If ct > 0 Then ThisWorkbook.Sheets("Лист1").Range("C4").Resize(ct, 1) = out End If End Sub
doober, Огромное спасибо! Вы просто чудо! Все работает именно так, как нужно
Можете ещё подсказать, возможно ли сделать, чтобы предыдущие найденные значения в столбцах С4, С5 и т.д. очищались с поиском новых значений?
doober, Огромное спасибо! Вы просто чудо! Все работает именно так, как нужно
Можете ещё подсказать, возможно ли сделать, чтобы предыдущие найденные значения в столбцах С4, С5 и т.д. очищались с поиском новых значений?Milirina555
А логика таже была что в первой версии что во второй версии кода от меня что очень странно для меня. Ну да ладно, ни и отлично что у вас заработал код.
А логика таже была что в первой версии что во второй версии кода от меня что очень странно для меня. Ну да ладно, ни и отлично что у вас заработал код.MikeVol