Как перебирать строки в Excel до тех пор, пока не будет найдено нужное значение?
В некоторых случаях может понадобиться построчно просматривать строки листа до тех пор, пока не будет найдено нужное значение. Ниже приведён макрокод, который поможет вам перебирать данные до обнаружения указанного значения.
Перебор строк до определённого значения
Перебор строк до определённого значения
1. Нажмите клавиши Alt + F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. Щёлкните Вставка > Модуль и вставьте приведённый ниже код в пустой Модуль.
VBA: Перебор строк до определённого значения
Sub LoopUntilSpecificValue()
'UpdatebyExtendoffice20161222
Dim fStr As String
Dim strActAddress As String
Dim fbool As Boolean
Dim cnt As Long, cntRow As Long
Dim xRg As Range, yRg As Range, zRg As Range
fbool = False
strActAddress = ""
cnt = 0
On Error Resume Next
Set zRg = ActiveSheet.UsedRange
cntRow = zRg.Rows.Count
Set xRg = Application.InputBox _
(Prompt:="Range select..", Title:="Kutools for Excel", Type:=8)
fStr = Application.InputBox _
(Prompt:="Search string?", Title:="Kutools for Excel", Type:=2)
Application.ScreenUpdating = False
For Each yRg In xRg
If yRg.Row > cntRow Then
MsgBox "Value not found ", vbInformation, "Kutools for Excel"
Application.ScreenUpdating = True
Exit Sub
End If
If yRg.Value2 = fStr Then
Application.ScreenUpdating = True
yRg.Activate
fbool = True
strActAddress = yRg.Address
MsgBox "Value found in cell " & strActAddress, vbInformation, "Kutools for Excel"
Exit Sub
Else
cnt = cnt + 1
End If
Next yRg
If cnt = xRg.Count Then
MsgBox "Value not found ", vbInformation, "Kutools for Excel"
End If
Application.ScreenUpdating = True
End Sub
3. Нажмите клавишу F5, чтобы открыть диалоговое окно для выбора столбца, по которому нужно выполнить перебор. См. снимок экрана:
4. Нажмите кнопку ОК, после чего во вновь появившемся диалоговом окне введите строку, которую необходимо найти. См. снимок экрана:
5. Нажмите «ОК» — программа будет последовательно просматривать выделенный диапазон, пока не найдёт указанное значение.
Примечание: если подходящее значение не найдено, появится диалоговое окно с уведомлением об отсутствии совпадений.
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек