Игнорировать скрытые строки и останавливать макрос после 10 пустых ячеек

Question

Я использую следующий макрос для перевода выделенных ячеек с помощью Google Translate.

Он работает как шарм, но я также хочу, чтобы он игнорировал скрытые строки и делал остановки после 10 пустых ячеек.

Кроме того, по какой-то причине в переведенной ячейке убраны разрывы строк, которые я действительно хочу сохранить.

Заранее благодарен за помощь.

Sub Translate()
    Dim getParam As String, trans As String, translateFrom As String, translateTo As String
    translateFrom = "en"
    translateTo = "fr"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim cell As Range
    Dim blanks As Long

    For Each cell In Selection.SpecialCells(xlCellTypeVisible)

    If blanks > 10 Then Exit For

    If cell.Value = "" Then
        blanks = blanks + 1
    Else

        getParam = ConvertToGet(cell.Value)
        URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
        objHTTP.Open "GET", URL, False
        objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        objHTTP.send ("")

        If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
            trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
            cell.Value = Clean(trans)
            cell.Interior.Color = RGB(255, 0, 0)
            cell.Font.Color = Black
            Cells.ClearComments
        End If

    End If

Next cell
End Sub

Answer 1

Вот пример кода, который вы можете использовать, который соответствует обоим вашим критериям:

1. Только l oop через видимые ячейки (xlCellTypeVisible)
2. Стоп-код (Exit For) после 10 пустых ячеек, найденных в течение l oop

Обратите внимание, что пробелы должны быть видны, чтобы их можно было рассмотреть здесь

Ваши заявления о действиях будут go вместо Debug.Print rng.Value в приведенном ниже примере кода

---

Sub Shelter_In_Place()

Dim cell As Range
Dim blanks As Long

For Each cell In Selection.SpecialCells(xlCellTypeVisible)

    If blanks > 10 Then Exit For
    'Depending on your actual code, you may need to use 'Exit Sub' instead

    If cell.Value = "" Then
        blanks = blanks + 1
    Else

        getParam = ConvertToGet(cell.Value)
        URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
        objHTTP.Open "GET", URL, False
        objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        objHTTP.send ("")

        If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
            trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
            cell.Value = Clean(trans)
            cell.Interior.Color = RGB(255, 0, 0)
            cell.Font.Color = Black
            Cells.ClearComments
        End If

    End If

Next cell


End Sub