Sub aQSort2(ByRef a() As Variant, ByVal N As Integer, ByRef low As Long, ByRef high As Long)
Dim i As Long, j As Long, k As Long
Dim m As Variant, wsp As Variant
i = low
j = high
m = a(Round((i + j) \ 2), N)
Do Until i > j
    Do While a(i, N) < m
        i = i + 1
    Loop
    Do While a(j, N) > m
        j = j - 1
    Loop
    If (i <= j) Then
        For k = LBound(a, 2) To UBound(a, 2)
        wsp = a(i, k)
        a(i, k) = a(j, k)
        a(j, k) = wsp
        Next k
        i = i + 1
        j = j - 1
    End If
Loop
If (low < j) Then aQSort2 a(), N, low, j
If (i < high) Then aQSort2 a(), N, i, high
End Sub

=--(СУММ(I2:J2)>0) 

=ЕСЛИ((СУММ(I9:J9)>0);"Y";"N")

Sub d()
    Dim a(), b(), c(), ax(), ay(), az()
    Dim full(), i&, ii&, iii&, t&
    Dim x&, y&, z&
    
    'задаем массивы
    With Sheets("Источник")
        i = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Row
        x = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Column
        a = Range(.Cells(2, 1), .Cells(i, x)).Value
        ax = Range(.Cells(1, 1), .Cells(2, x)).Value
    End With
    With Sheets("Источник 2")
        i = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Row
        y = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Column
        b = Range(.Cells(2, 1), .Cells(i, x)).Value
        ay = Range(.Cells(1, 1), .Cells(2, y)).Value
    End With
    With Sheets("Источник 3")
        i = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Row
        z = .Cells.Find("*", .[a1], xlFormulas, 1, 2, 2).Column
        c = Range(.Cells(2, 1), .Cells(i, z)).Value
        az = Range(.Cells(1, 1), .Cells(2, z)).Value
    End With
    ReDim full(1 To UBound(a) * UBound(b) * UBound(c), 1 To x + y + z)
    For i = 1 To UBound(a)
        For ii = 1 To UBound(b)
            For iii = 1 To UBound(c)
            t = t + 1
                Count = 1
                'заполняем элементы массива
                For g = 1 To x: full(t, Count) = a(i, g): Count = Count + 1: Next g
                For g = 1 To y: full(t, Count) = b(ii, g): Count = Count + 1: Next g
                For g = 1 To z: full(t, Count) = c(iii, g): Count = Count + 1: Next g
            Next iii, ii, i
            
    Sheets.Add
    With Sheets(1)
        .Activate
        .Cells(1, 1).Resize(UBound(ax), UBound(ax, 2)) = ax
        .Cells(1, 1 + x).Resize(UBound(ay), UBound(ay, 2)) = ay
        .Cells(1, 1 + x + y).Resize(UBound(az), UBound(az, 2)) = az
        .Cells(2, 1).Resize(UBound(full), UBound(full, 2)) = full
    End With
End Sub

ReDim full(1 To UBound(a) * UBound(b) * UBound(c), 1 To 10)

ReDim full(1 To UBound(a) * UBound(b) * UBound(c), 1 To x + y + z)

With Sheets("Источник"): a = Range(.Cells(1, 1), .Cells(7, x)).Value: End With

=ТЕКСТ(B3;"0-000-000-00-00")

=ЕСЛИ(B1="";СМЕЩ(E1;-1;);B1) 

Sub РРР()
    Dim arr, i&, ii&
    arr = Selection.Value
    For i = 2 To UBound(arr)
        For ii = 1 To UBound(arr, 2)
        If Len(arr(i, ii)) = 0 Then arr(i, ii) = arr(i - 1, ii)
    Next ii, i
    Selection = arr
End Sub

Sub d()
Dim a(), b(), c(), full(), i&, ii&, iii&, t&
a = [a2:b4].Value
b = [d2:e5].Value
c = [g2:h6].Value
ReDim full(1 To UBound(a) * UBound(b) * UBound(c), 1 To 6)
For i = 1 To UBound(a)
    For ii = 1 To UBound(b)
        For iii = 1 To UBound(c)
        t = t + 1
            full(t, 1) = a(i, 1): full(t, 2) = a(i, 2)
            full(t, 3) = b(ii, 1): full(t, 4) = b(ii, 2)
            full(t, 5) = c(iii, 1): full(t, 6) = c(iii, 2)
        Next iii, ii, i
Sheets.Add
[a1:f1] = Array("Город", "Транслит", "Транспорт", "Транспорт, Eng", "Цвет", "Цвет, англ")
[a2].Resize(UBound(full), 6) = full
End Sub

Если(a2="";f1;a2)

Sub d()
Dim c As Range, cF As Range, b As Boolean
For Each c In Range("A1").CurrentRegion
    If c.Value = "Маша" Then
        If Not b Then b = True Else If cF Is Nothing Then Set cF = c Else Set cF = Union(c, cF)
    End If
Next
cF.EntireRow.Delete
End Sub

Year([Дата])
Month([Дата])

FORMAT([Дата];"YYYY")
FORMAT([Дата];"MMM")

pRSet.Fields.Append "F" & CStr(k), 5

pRSet.Fields.Append "F" & CStr(k), 203, 20