[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

[Iska]

XL. ActiveWorkbook.SaveAs BookOut »

Как тут пробел затесался?

[megaloman]

Iska, Вкрался. Исправил. Но, самое интересное, работало нормально.

[Iska]

Но, самое интересное, работало нормально. »

Странно. Я, впрочем, не проверял.

[Fantastish]

Доброго дня. Спасибо за скрипт.
Но у меня еще просьба, попробовал оптимизировать скрипт под свой файл, получил ошибку

Скрытый текст

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

Что в 28 строке символ 13 - несоответствие типа

[megaloman]

Fantastish, А что в 28 строке скрипта? Упакуйте или переименуйте его в тхт, пришлите, надо смотреть. А еще лучше с Вашим ексел-файлом. Упакуйте, можете с паролем, пароль в личное сообщение. То, что Вы выложили - похоже ошибочно. У вас в имени колонки "С" русская буква.

[Fantastish]

Отправил в пм, спасибо

[megaloman]

Fantastish, Ваша ситуация оказалась сложнее.
1. В исходном файле несколько листов с взаимными связями
2. Формулы не всегда выдают корректный результат

Вот изменённый код с учетом особенностей Вашей таблицы.

Код:

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

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

Set FSO = CreateObject("Scripting.FileSystemObject")
Set XL = CreateObject("Excel.Application")

With XL

.Visible = True

.Workbooks.Open Book
.Sheets(List).Select

    .Range(Col1+":"+Col2).Copy
    aaa=.Range(Col1+":"+Col2).PasteSpecial(-4163, -4142, False, False)
    
    .Sheets(List).Copy

    .Windows(FSO.GetFile(Book).Name).Close (False)
    
    C1 = .Range(Col1 + "1").Column
    C2 = .Range(Col2 + "1").Column
    C0 = .Range(Col0 + "1").Column
    
    R1 = Col1 + CStr(Row1)
    
    i = Row1 - 1
    Do
        i = i + 1
        L = False
        For j = C1 To C2
    		On Error Resume Next
    		RR1=.Range(R1).Offset(i - Row1, j - C1)
    		If Err.Number <> 0 Then
			RR1="Н/Д"
			.Range(R1).Offset(i - Row1, j - C1)=RR1
    		End If
            	L = L Or RR1 <> ""
        Next
        If Not L Then Exit Do
    Loop
    Row2 = i - 1
    
    ' Dim Mas As Variant
    Mas = .Range(R1 + ":" + Col2 + CStr(Row2))
    .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
            .Range(R22).Offset(NN, 0) = Mas1
            NN = NN + 1
            ' MsgBox CStr(i) + " " + Mas(i, j)
        End If
    Next
    
    .Range("A1").Select


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

.ActiveWorkbook.SaveAs BookOut
.Quit
End With

1. Формируется новая таблица с одним листом безо всяких формул
2. Игнорируются ошибки при работе Ваших формул

[Fantastish]

Огромное спасибо
Вопрос:
параметр .Visible = True - определяет в silent режиме откроется приложение или нет?
и еще одна глупая возможность, может ли скрипт в процессе обработки, удалять (подчищать пустые строки)?