cmdkey /generic:101.101.101.101 /user:12345 /pass:123456

Option Explicit
Dim valUserIn
Dim objShell, RegLocate, RegLocate1
Dim args

set args = Wscript.Arguments
valUserIn = args(0)
Set objShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer"
objShell.RegWrite RegLocate,valUserIn,"REG_SZ"
RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable"
objShell.RegWrite RegLocate,"1","REG_DWORD"
WScript.Quit

Sub GroupDigits()
  Dim SelectionStart As Long
  Dim SelectionEnd As Long
  
  SelectionStart = Selection.Start
  SelectionEnd = Selection.End
  Selection.EndKey wdStory, wdMove
  
  With Selection.Find
    .Text = "[0-9]{4;}"
    .MatchWildcards = True
    .Forward = False
    While .Execute
      If Not .Parent.Previous Is Nothing Then
        If .Parent.Previous.Text <> "," Then
          .Parent.Text = FormatNumber(CDbl(.Parent.Text), 0, GroupDigits:=vbTrue)
          Selection.Collapse wdCollapseStart
        End If
      Else
        .Parent.Text = FormatNumber(CDbl(.Parent.Text), 0, GroupDigits:=vbTrue)
      End If
    Wend
  End With
  
  Selection.SetRange SelectionStart, SelectionEnd

End Sub

Sub XMLHTTP()
ctroka:
URL = "https://oz-parts.ru/search/Hyundai-KIA/54584D3000?source=goods_info"
 On Error GoTo errorHandler
        With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", URL, "False"
        .setTimeouts 10000, 10000, 10000, 10000
        .send ("")
'        .setProxy 2, myProxy
'        .setProxyCredentials mylogin, mypassword
cTime = Now + TimeValue("00:00:20")
 If Now < cTime Then
        Do
        DoEvents
        Loop Until .readyState = 4
Else
        popitka = popitka + 1
        If popitka >= 3 Then
        Exit Sub
        Else
        GoTo ctroka:
        End If
End If
        txt = .responseText
        End With
errorHandler:

arr50 = Split(GetTags(txt, "td", "class", "*resultDeadline *", "innerHTML"), ARSEP)
kolishestvo1 = UBound(arr50, 1) - LBound(arr50, 1) + 1

Sub CheckProxy()
    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", "https://clarity-project.info", False
        .setProxy 2, "77.37.202.134:10187"
        .setProxyCredentials "Login", "Pass" 'логин и пароль ввожу правильные
        .setTimeouts 10000, 10000, 10000, 10000
        .send ("")
        Debug.Print .Status, .statustext
    End With
End Sub

=ПСТР(ЯЧЕЙКА("ИМЯФАЙЛА";a);ПОИСК("]";ЯЧЕЙКА("ИМЯФАЙЛА";a))+1;255)

=ПСТР(ЯЧЕЙКА("ИМЯФАЙЛА";A1);ПОИСК("]";ЯЧЕЙКА("ИМЯФАЙЛА";A1))+1;255)

=ПРАВСИМВ(ЯЧЕЙКА("имяфайла");ДЛСТР(ЯЧЕЙКА("имяфайла"))-ПОИСК("]";ЯЧЕЙКА("имяфайла")))

=LAMBDA(a;ПСТР(ЯЧЕЙКА("ИМЯФАЙЛА";a);ПОИСК("]";ЯЧЕЙКА("ИМЯФАЙЛА";a))+1;255))

=ЕСЛИ(ЕПУСТО(A1);"";"на " & ЦЕЛОЕ((A1-1)/5)+1 & ЕСЛИ(ПРАВСИМВ(ЦЕЛОЕ((A1-1)/5)+1;1)*1=1;" листе.";" листах."))

Sub Test1() ' старый вариант, этот на моем ПК, выполняется за 17с
    Dim arr, lr, ss    As Long

    arr = Worksheets("Лист3").Range(Cells(1, 2), Cells(10000, 2)).Value
    For lr = 1 To 10000
        If arr(lr, 1) >= 85 Then
            ss = 28
        Else
            ss = 14
        End If
     Worksheets("Лист3").Rows(lr).RowHeight = ss
    Next
End Sub


Sub Test2() ' новый вариант, этот на моем ПК, выполняется за 3с
Dim i As Long
Dim Rg1 As Range, Rg2 As Range, nRow&, Min%, Max%, Arr1
nRow = 10000: Min = 14: Max = 28: Set Rg2 = Worksheets("Лист3").Rows("1:" & nRow)
Arr1 = Range(Cells(1, 2), Cells(nRow, 2))
    For i = 1 To nRow
If Arr1(i, 1) >= 85 Then If Rg1 Is Nothing Then Set Rg1 = Rg2.Cells(i, 1) Else Set Rg1 = Union(Rg2.Cells(i, 1), Rg1)
    Next
If Not Rg1 Is Nothing Then
    Rg1.EntireRow.RowHeight = Max
    Rg1.EntireRow.Hidden = True
    Rg2.SpecialCells(xlCellTypeVisible).EntireRow.RowHeight = Min
    Rg2.EntireRow.Hidden = False
End If
End Sub

Sub skritie()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String

    ТекстДляПоиска = ""    ' скрываем строки с таким текстом

    'перебираем все строки в используемом диапазоне листа
    For Each ra In Range("B45:B94").Rows
        'если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            'добавляем строку в диапазон для скрытия
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next

    'если подходящие строки найдены - скрываем  их
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True

End Sub

Sub Test()
Dim arr, lr, i, ss As Long
arr = Range(Cells(1, 18), Cells(160, 18)).Value
For lr = 1 To 160
    If arr(lr, 1) >= 85 Then
    ss = 28
    Else
    ss = 14
    End If
    Worksheets("Лист2").Rows(lr + 98).rowheight = ss
Next
End Sub.

Sub Test()
Dim arr, lr, i, ss As Long
arr = Range(Cells(1, 18), Cells(160, 18)).Value
For lr = 1 To 160
    If arr(lr, 1) >= 85 Then
    ss = 28 ' при значении lr=1,7,8,9,15,19,22 и т.д.( это должно быть как бы первым набором для условия)
    Else
    ss = 14 ' при значении lr=2,3,4,5,6,10,11 и т.д., т .е. все остальные ( это должно быть вторым набором для условия)
    End If
Next
' и вот здесь накопленный, набор в данном случае строки (1,7,8,9,15,19,22 и т.д.) имеет высоту = 22; а второй накопленный набор  (1,7,8,9,15,19,22 и т.д.) имеет высоту = 14.
End Sub.