[A1].Characters.Text(Start, Length)
[A1].Characters(Start, Length).Caption

Sub Tester()
    With ActiveSheet
        AddValue .Range("A1"), "Hello", vbRed
        AddValue .Range("A1"), "Hello", vbGreen
        AddValue .Range("A1"), "Hello", vbBlue
    End With
End Sub
Sub AddValue(rngVal As Range, val, theColor As Long)
    Const SEP As String = " "
    Dim firstChar As Long, extra As Long
    firstChar = 1 + Len(rngVal.Value)
    extra = IIf(firstChar = 1, 0, 1)
    With rngVal
        .Characters(firstChar).Text = IIf(Len(rngVal.Value) > 0, SEP, "") & val
        .Characters(firstChar + extra, Len(val)).Font.Color = theColor
    End With
End Sub

Sub RunConcat()
  ConcatenatewithFormat Selection, ThisWorkbook.ActiveSheet.Cells(Selection.Row, Selection.Column + Selection.Columns.Count)
End Sub
Sub ConcatenateWithFormat(InputRange As Range, OutPutRange As Range)
Dim i As Integer, q As Variant
Dim sText As String, c As String, A As Variant
Dim oChars As Characters, n As Integer
  OutPutRange.Clear: n = 0
  For Each A In InputRange
    sText = A.Text
    For i = 1 To Len(sText)
      Set oChars = A.Characters(i, 1)
      Set q = OutPutRange.Characters(i + n, 1)
      q.Caption = oChars.Caption
      With oChars
        q.Font.Bold = .Font.Bold
        q.Font.Name = .Font.Name
        'q.Font.Color = .Font.Color
        q.Font.ColorIndex = .Font.ColorIndex
        q.Font.FontStyle = .Font.FontStyle
        q.Font.OutlineFont = .Font.OutlineFont
        q.Font.Size = .Font.Size
        q.Font.Strikethrough = .Font.Strikethrough
        q.Font.Subscript = .Font.Subscript
        q.Font.Superscript = .Font.Superscript
        q.Font.Underline = .Font.Underline
      End With
    Next i
    n = n + Len(sText)
  Next A
End Sub

Sub TabTest()
If i = 1 Then
j = 2
End If
End Sub

Sub TabTest()
    If i = 1 Then
        j = 2
    End If
End Sub

WindowsFormsExtensions.SetTaskbarProgress(this, 35);
this.SetTaskbarProgressState(Windows7Taskbar.ThumbnailProgressState.Normal);

for i=1 to 100
Application.Progress(i)
next i

SetForegroundWindow w.hwnd
ShowWindow w.hwnd, 5
retval = SendMessage(w.hwnd, WM_SETFOCUS, 0, 0)

Const VK_H = 72, VK_E = 69, VK_L = 76, VK_O = 79, KEYEVENTF_KEYUP = &H2, INPUT_MOUSE = 0, INPUT_KEYBOARD = 1, INPUT_HARDWARE = 2
Type MOUSEINPUT: dx As Long: dy As Long: mouseData As Long: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type KEYBDINPUT: wVk As Integer: wScan As Integer: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type HARDWAREINPUT: uMsg As Long: wParamL As Integer: wParamH As Integer: End Type
Type GENERALINPUT: dwType As Long: xi(0 To 23) As Byte: End Type
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Sub go1()
AppActivate "Блокнот"
SendKey VK_H: SendKey VK_E: SendKey VK_L: SendKey VK_L: SendKey VK_O
End Sub
Sub SendKey(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = bKey
KInput.dwFlags = 0
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
KInput.wVk = bKey
KInput.dwFlags = KEYEVENTF_KEYUP
GInput(1).dwType = INPUT_KEYBOARD
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(2, GInput(0), Len(GInput(0)))
End Sub

set obj = Nothing
max-age=0
no-cache, no-store, must-revalidate
"If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
?hash=rnd

asd1qwd1er345568678345111

Sub auto_open()
Application.OnKey "^{TAB}", "Переход1" 'Ctrl+TAB 'следующий лист
Application.OnKey "^+{TAB}", "Переход2" 'Ctrl+Shift+TAB 'прошлый лист
End Sub

Sub Переход1()
Application.ScreenUpdating = False
On Error Resume Next
Application.OnKey "^{TAB}", ActiveSheet.Next.Select 'Ctrl+TAB 'следующий лист
Application.ScreenUpdating = True
End Sub

Sub Переход2()
Application.ScreenUpdating = False
On Error Resume Next
Application.OnKey "^+{TAB}", ActiveSheet.Previous.Select 'Ctrl+Shift+TAB 'прошлый лист
Application.ScreenUpdating = True
End Sub

Sub test1()
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
End Sub

Sub test2()
[D1:D10].ClearContents
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
[D1] = "111"
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
End Sub

Erase a 'массив
Set a = Nothing 'object, range
a = VbNullString '$
a = "" '$
a = Empty '&
a = 0 '&

Sub test()
Set t1 = Union([a1:c1], [a3:d4])
t2 = t1.Rows.Count
t1.Select
End Sub

AVDoc.GetAVPageView.ZoomTo 1, 1
doc.zoomtype = jso.zoomtype.fitP
Exch.MenuItemExecute ("FitPage")
doc.app.execMenuItem ("FitPage")

jso.getField("Name").Value = "text"

Sub test()
txt = "123abc123"
For i = 1 To Len(txt)
y = Сложение(Mid(txt, i, 1))
on error debug.Print i
Next
End Sub
Function Сложение(x$) As Long
Сложение = x + 1
End Function