Поиск значений из другого листа (цикл в цикле) - PullRequest
0 голосов
/ 21 мая 2018

Я хотел бы автоматизировать процесс Excel с помощью VBA.

Сценарий должен перемещать ячейка за ячейкой в выбранной области на Sheet3.Каждая ячейка содержит номер или является пустой.Сценарий запускается и ищет значение каждой ячейки в определенном диапазоне на Листе 2.Когда он что-то находит, содержимое всей строки, в которой он был найден, должно выделяться жирным шрифтом. Если ничего не находит, он просто переходит к следующей ячейке.

После просмотра здесь на stackoverflow и различных руководств мне удалось составить скрипт.У него нет ошибок, но он ничего не делает.


Sub MacroText()
Dim xlRng As Range
Dim rng As Range
Dim xlSht As Worksheet
Dim sht As Worksheet
Dim iLastRow As Integer
Dim iRow As Integer
Dim bFound As Boolean
Dim xCell As Range
Dim xlCell As Range
Dim valueToFind As String



 bFound = False
Set sht = ActiveWorkbook.Worksheets("Sheet3")
Set xlSht = ActiveWorkbook.Worksheets("Sheet2")
Set rng = Selection
Set xlRng = ActiveWorkbook.Worksheets("Sheet2").Range("A:A")

iLastRow = xlSht.Range("A1").End(xlDown).Row

Set xlRng = xlSht.Range("A1:A" & iLastRow)

For Each xCell In rng
    valueToFind = xCell.Value

    For Each xlCell In xlRng
        Worksheets("Sheet2").Activate
        If xlCell.Value = valueToFind Then
            bFound = True
            iRow = xlCell.Row
            Rows(iRow).Font.Bold = True
            End If


            If bFound = True Then Exit For
            End
    Next xlCell

Next xCell

End Sub

Я предполагаю, что это должно быть что-то с позиционированием в коде, но я не смог найти никакой информации для этого.Проработав 12 часов, я был бы очень признателен за вашу помощь.

Ура!

Ответы [ 2 ]

0 голосов
/ 21 мая 2018

Вы можете использовать метод Find для достижения этой цели вместо второго цикла

Sub MacroText()
    Dim xlRng As Range
    Dim rng As Range
    Dim xlSht As Worksheet
    Dim sht As Worksheet
    Dim iLastRow As Long
    Dim iRow As Long
    Dim bFound As Boolean
    Dim xCell As Range
    Dim xlCell As Range
    Dim valueToFind As String
    Dim FoundRange As Range

    bFound = False
    Set sht = ActiveWorkbook.Worksheets("Sheet3")
    Set xlSht = ActiveWorkbook.Worksheets("Sheet2")
    Set rng = Selection
    Set xlRng = ActiveWorkbook.Worksheets("Sheet2").Range("A:A")

    iLastRow = xlSht.Range("A1").End(xlDown).Row

    Set xlRng = xlSht.Range("A1:A" & iLastRow)

    For Each xCell In rng
        Set FoundRange = Nothing
        Set FoundRange = xlRng.Find(what:=xCell.Value2)

        If Not FoundRange Is Nothing Then
            FoundRange.EntireRow.Font.Bold = True
        End If

    Next xCell

End Sub
0 голосов
/ 21 мая 2018
For Each xlCell In xlRng
    Worksheets("Sheet2").Activate
        If xlCell.Value = valueToFind Then
            xlCell.EntireRow.Font.Bold = True
        End If
Next xlCell  

Я не знаю, что вы не получаете, но я предположил, что вы не получаете желаемый ряд жирным шрифтом.Замените приведенный выше код на ваш цикл for и запустите.Я не проверял это, но не уверен, что не работаю.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...