Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Contributor


Сообщения: 2728
Благодарности: 1697

Профиль | Отправить PM | Цитировать


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. Игнорируются ошибки при работе Ваших формул

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.

Это сообщение посчитали полезным следующие участники:

Отправлено: 17:35, 30-05-2016 | #9