[megaloman]

vbs-скрипт

Код:

Book = "Z:\форум.xlsx"
BookOut="Z:\форум_свобода.xlsx"

    List = "Данные" ' Имя листа с данными
    Col1 = "A"  ' Первая колонка с данными
    Col2 = "H"  ' Последняя колонка с данными
    Col0 = "D"  ' Колонка с данными для анализа
    Row1 = 2    ' Первая строка с данными

Set FSO = CreateObject("Scripting.FileSystemObject")
Set XL = CreateObject("Excel.Application")
XL.Visible = True
XL.Workbooks.Open Book

XL.Sheets(List).Select
    
    C1 = XL.Range(Col1 + "1").Column
    C2 = XL.Range(Col2 + "1").Column
    C0 = XL.Range(Col0 + "1").Column
    
    R1 = Col1 + CStr(Row1)
    
    i = Row1 - 1
    Do
        i = i + 1
        L = False
        For j = C1 To C2
            L = L Or XL.Range(R1).Offset(i - Row1, j - C1) <> ""
        Next
        If Not L Then Exit Do
    Loop
    Row2 = i - 1
    
    ' Dim Mas As Variant
    Mas = XL.Range(R1 + ":" + Col2 + CStr(Row2))
    XL.Range(R1 + ":" + Col2 + CStr(Row2)).ClearContents
    N1 = LBound(Mas, 1)
    N2 = UBound(Mas, 1)
    
    N22 = UBound(Mas, 2) - LBound(Mas, 1)
    R22 = Col1 + CStr(Row1) + ":" + Col2 + CStr(Row1)
    ReDim Mas1(N22)
    NN = 0
    For i = N1 To N2
        j = C0 - C1 + N1
        If (Len(Trim(Mas(i, j))) = 0) Or (InStr(1, Mas(i, j), "Свобод") <> 0) Then
            For jj = 0 To N22
                Mas1(jj) = Mas(i, jj + N1)
            Next
            XL.Range(R22).Offset(NN, 0) = Mas1
            NN = NN + 1
            ' MsgBox CStr(i) + " " + Mas(i, j)
        End If
    Next
    
    XL.Range("A1").Select


If FSO.FileExists(BookOut) Then FSO.DeleteFile(BookOut)

XL.ActiveWorkbook.SaveAs BookOut
XL.Quit