Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Александр
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 След.
Удаление элементов управления с листов из списка
 
#
06.09.2018 15:34:59
Прошу прощения, RAN. Очень обрадовался решению, предложенному Вами  :)  
 
Перейти    
Удаление элементов управления с листов из списка
 
#
06.09.2018 15:18:45
Спасибо, RAN!  С твоим решением код из примера тоже заработал.
Код
Sub Clear()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaList As Range 'список консолидируемых листов
        Set BazaWb = ThisWorkbook
        Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6") 'устанавливаем список листов
            For Each n In BazaList 'для каждого листа из списка удаляем элементы управления
                iNameSht = n
                If iNameSht <> "" And iNameSht <> "КТТ" Then
                With Sheets(iNameSht)
                    .Rows.Hidden = False   'отменяем все скрытия строк
                    .Columns.Hidden = False   'отменяем все скрытия строк
                    .CheckBoxes.Delete
                End With
                End If
            Next
End Sub
 
Перейти    
Удаление элементов управления с листов из списка
 
#
06.09.2018 14:39:28
Прикладываю пример
 
Перейти    
Удаление элементов управления с листов из списка
 
#
06.09.2018 13:45:43
Добрый день!

Друзья, нужна помощь в отладке кода, а именно в части формулировки команды на удаление элемента управления формы - флажок.
Код
Sub Clear()
    Dim BazaWb As Workbook 'отчет
    Dim BazaList As Range 'список проверяемых листов
    Dim iNameSht As String ' имя проверяемого листа
        Set BazaWb = ThisWorkbook
        Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6") 'устанавливаем список листов
            For Each n In BazaList 'для каждого листа из списка удаляем элементы управления
                iNameSht = n
                If iNameSht <> "" And iNameSht <> "КТТ" Then 'исключаем из проверки один из листов в списке и пустые позиции
                With Sheets(iNameSht)
                    Rows.Hidden = False   'отменяем все скрытия строк
                    Columns.Hidden = False   'отменяем все скрытия строк
                    .Shapes.Delete
                End With
                End If
            Next
End Sub
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
31.08.2018 10:59:15
Недосмотрел при подготовке примера. Файл обрабатывает массив нормативов на более чем 10 000 строк, находящийся во внешнем файле.
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
31.08.2018 08:46:47
Используются разные нормативные базы по регионам, размерность которых зависит от присутствующей там техники.
Спасибо за уделенное время и решения!
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
30.08.2018 17:26:18
Вы правы, сбил один аргумент. В текущем вложении именованные формулы исправил, можно проверить введя НБ_Алтай.
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
30.08.2018 16:05:27
В соответствующие имена внесены формулы, извлекающие норматив из соответствующей внешней базы. ВПР() по коду региона определяет, какая из формул должна быть использована для текущего расчета.
ДВССЫЛ() использовать не получается.
Изменено: Александр - 30.08.2018 16:23:48
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
30.08.2018 14:58:19
Не срабатывает. Прикладываю пример.
Изменено: Александр - 30.08.2018 15:53:18
 
Перейти    
Вызов именованной формулы по условию, Нужен пользовательский аналог ДВССЫЛ для работы с именованными формулами.
 
#
30.08.2018 14:35:20
Добрый день!

Созданы именованные формулы ИНДЕКС() для определения значения норматива из баз по регионам. По коду региона, с помощью формулы "НБ_"&Регион генерируется имя именованной формулы, которая должна быть вызвана. Но вызвать именованную формулу способом ниже не удается, подскажите, ошибку.
Код
Function UseThisName(iName As String)
    UseThisName = Name(iName).Value
End Function
 
Перейти    
Пользовательская функция Индекс
 
#
05.08.2018 19:12:51
Супер, работает. Проблема была в формировании имени листа?
 
Перейти    
Пользовательская функция Индекс
 
#
05.08.2018 18:41:41
Заработал WbIndex
 
Перейти    
Пользовательская функция Индекс
 
#
05.08.2018 18:15:00
Большое спасибо! Теперь можно отдохнуть:)
 
Перейти    
Пользовательская функция Индекс
 
#
05.08.2018 17:32:39
Добрый день!

В файле имеется сводная техн. карта и техн. карты по культурам, в которых пользователем указывается техника. Задача в том, чтобы в сводную техн. карту собрать технику со всех тематических карт. В столбце "B" в значении ячеек есть косвенное указание в виде аббревиатуры на тематический лист, в котором необходимо произвести поиск, а также уникальный код ТО.

Подскажите в какой части кода пользовательской функции мной допущена ошибка:
Код
Вариант 1:
Function wbFind(IDRange As Range, iNumberColumn As Long, StCell As String, Number1 As Integer, Number2 As Integer)

    wbFind = Thisworkbooks.Sheets("ТК_" & Left(IDRange.Value, 3)).Columns(iNumberColumn) _
            .Find(IDRange.Value, Range(StCell), xlValues, xlWhole, xlByRows, xlNext).cell.Offset(Number1, Number2).Value

End Function

Вариант 2:
Function WbIndex(IDRange As Range, iRangeValue As String, iRangeCri As String)
    
    WbIndex = Application.WorksheetFunction.Index(Thisworkbooks.Sheets("ТК_" & Left(IDRange.Value, 3)).Range(iRangeValue), _
            WorksheetFunction.Match(IDRange, Thisworkbooks.Sheets("ТК_" & Left(IDRange.Value, 3)).Range(iRangeCri), 0))

End Function
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
31.07.2018 16:06:58
Выкладываю окончательный рабочий код, может перед кем-то стоит аналогичная задача:
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iNameSht As String ' имя консолидируемого листа
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastColumnBaza As Long 'последний заполненный столбец в файле
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False ' отключаем обновление экрана
       .DisplayAlerts = False
       .Calculation = xlManual 'вкл. пересчёт книги вручную
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23") 'устанавливаем список адресов книг-источников
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6") 'устанавливаем список листов, участвующих в консолидации
            For Each n In BazaList 'для каждого листа из списка производим очистку старых данных путем удаления строк
                iNameSht = n
                If iNameSht <> "" Then
                iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1 'определяем последнюю заполненную строку на листе из списка консолидирующей книги
                iLastColumnBaza = BazaWb.Sheets(iNameSht).Cells(3, Columns.Count).End(xlToLeft).Column 'определяем последний заполненный столбец на листе из списка консолидирующей книги
                .Sheets(iNameSht).Range(.Sheets(iNameSht).Rows(5), .Sheets(iNameSht).Rows(iLastRowBaza)).Delete 'Shift:=xlLeft
                End If
            Next
            For Each i In BazaAdress 'где i адрес каждого из файлов
                iTempFileName = i
                If iTempFileName <> "" Then
                With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each n In BazaList
                    ' где n имя каждого листа из списка
                    iNameSht = n
                    If iNameSht <> "" Then
                            iLastRowTempWb = .Sheets(iNameSht).Columns("A").Find("x", Range("A1"), xlValues, xlWhole, xlByRows, xlNext).Row - 1 'определяем последнюю строку с данными на листе из списка книги-источника
                            iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1 'определяем пустую строку следующую после строки с данными на листе из списка консолидирующей книги
                            .Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(4, 1), .Sheets(iNameSht).Cells(iLastRowTempWb, Columns.Count)).Copy 'копируем данный из книги-источника
                            BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False ' вставляем скопированные данные в консолидирующую книгу
                    End If
                    Next ' следующее имя листа из списка
                   .Close saveChanges:=False 'закрыаем просмотренную книгу-источник
                End With
                End If
            Next 'следующая книга источник
            For Each n In BazaList ' для каждого листа списка для консолидирующей книги
                iNameSht = n
                iNameObj = n
                If iNameSht <> "" Then
                     iLastColumnBaza = BazaWb.Sheets(iNameSht).Cells(3, Columns.Count).End(xlToLeft).Column ' определяем последний заполненный столбец в ситроке 3 заголовка умной таблицы
                     iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row 'определяем последнюю заполненную строку по столбцу 2
                     .Sheets(iNameSht).ListObjects(iNameObj).Resize Range(.Sheets(iNameSht).Cells(3, 1), .Sheets(iNameSht).Cells(iLastRowBaza, iLastColumnBaza)) 'актуализируем размер умной таблицы
                End If
            Next
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
       .Calculation = xlManual
    End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
Изменено: Александр - 31.07.2018 16:09:40 (Удалил записи незадействованные в коде)
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
31.07.2018 09:18:54
Друзья, помогите оптимизировать завершающие части макроса выше:
1) Очистка старых данных (выдает ошибку 1004 на строке 5).
2) Изменение размера умных таблиц
Код
 1)           For Each n In BazaList
                iNameSht = n
                If iNameSht <> "" Then
                iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
                BazaWb.Sheets(iNameSht).Rows(iLastRowBaza, Rows.Count).Delete Shift:=xlUp
                End If
            Next

2)            For Each n In BazaList
                iNameSht = n
                If iNameSht <> "" Then
                     iLastColumnBaza = BazaWb.Sheets(iNameSht).Cells(3, Columns.Count).End(xlToLeft).Column
                     iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row
                     BazaWb.Sheets(iNameSht).ListObjects(iNameSht).Resize Range(.Sheets(iNameSht).cell(3, 1), .Sheets(iNameSht).cell(iLastRowBaza, iLastColumnBaza))
                End If
            Next
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
30.07.2018 17:46:37
Выкладываю рабочий код. К сожалению, пока не удалось доработать части выделенные красным, а именно:
1) Строки 19-26. Очистка отчета от старых данных.
2) Строки 49-56. Изменение размера умных таблиц, в соответствии с новыми данными.
Если кто-то откликнется, буду благодарен.
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iNameSht As String ' имя консолидируемого листа
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastColumnBaza As Long 'последний заполненный столбец в файле
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23")
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6")
            'For Each n In BazaList
                'iNameSht = n
                'If iNameSht <> "" Then iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(3, 2).End(xlUp).Row
                'If iLastRowBaza >= 4 Then
                'BazaWb.Sheets(iNameSht).Rows(iLastRowBaza + 1).Delete Shift:=xlDown
                'End If
                '.Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(5, 2), .Cells(iLastRowBaza, Columns.Count)).Row.Delete
            'Next
            For Each i In BazaAdress 'где i адрес каждого из файлов
                iTempFileName = i
                If iTempFileName <> "" Then
                With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each n In BazaList
                    ' где n имя каждого листа из списка
                    iNameSht = n
                    If iNameSht <> "" Then
                            iLastRowTempWb = .Sheets(iNameSht).Columns("A").Find("x", Range("A1"), xlValues, xlWhole, xlByRows, xlNext).Row - 1
                            iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
                            .Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(4, 1), .Sheets(iNameSht).Cells(iLastRowTempWb, Columns.Count)).Copy
                            BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                    End If
                    Next
                   .Close saveChanges:=False
                End With
                End If
            Next
            'For Each n In BazaList
                'iNameSht = n
                'If iNameSht <> "" Then
                     'iLastColumnBaza = BazaWb.Sheets(iNameSht).Cells(3, Columns.Count).End(xlToLeft).Column
                     'iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row
                     'BazaWb.Sheets(iNameSht).ListObjects(iNameSht).Resize Range(.Sheets(iNameSht).cell(3, 1), .Sheets(iNameSht).cell(iLastRowBaza, iLastColumnBaza))
                'End If
            'Next
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
       .Calculation = xlManual
    End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
Изменено: Александр - 30.07.2018 17:48:48
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
30.07.2018 17:14:02
Подскажите, в чем может быть ошибка в коде изменения размера умной таблицы, ругается на строку 4:
Код
If iNameSht <> "" Then
   iLastColumnBaza = BazaWb.Sheets(iNameSht).Cells(3, Columns.Count).End(xlToLeft).Column
   iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row
   BazaWb.Sheets(iNameSht).ListObjects(iNameSht).Resize Range(.Sheets(iNameSht).cell(3, 1), .Sheets(iNameSht).cell(iLastRowBaza, iLastColumnBaza))
End If
Изменено: Александр - 30.07.2018 17:14:38
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
30.07.2018 15:01:18
Да, это дальнейшее развитие темы. Для наглядности задачи приложил консолидирующий файл и файл-источник. Нуждаюсь в помощи по отладке макроса.
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
30.07.2018 14:54:38
И опять нужна помощь. Приведенный ниже макрос зацикливается на команде Find и беспрерывно копирует данные с одного листа (К).
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iNameSht As String ' имя консолидируемого листа
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23")
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6")
       For Each n In BazaList
           iNameSht = n
           If iNameSht <> "" Then iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(5, 3).End(xlUp).Row
           If iLastRowBaza <> 4 Then BazaWb.Sheets(iNameSht).Rows(iLastRowBaza).Delete Shift:=xlDown
       Next
       For Each i In BazaAdress
       'где i адрес каждого из файлов
       iTempFileName = i
               Do While iTempFileName <> ""
               With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each n In BazaList
                    ' где n имя каждого листа из списка
                    iNameSht = n
                    Do While iNameSht <> ""
                            iLastRowTempWb = .Sheets(iNameSht).Columns("A").Find("x", Range("A1"), xlValues, xlWhole, xlByRows, xlNext).Row - 1
                            iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
                            .Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(5, 1), .Sheets(iNameSht).Cells(iLastRowTempWb, Columns.Count)).Copy
                            BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                    Loop
                    Next
                   .Close saveChanges:=False
                End With
               Loop
        Next
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
   End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 19:45:19
Работает, но выдает ошибку, если n в списке имен пусто. Не подскажите, какую альтернативу можно использовать для поиска последней пустой строки, так как в источниках используется таблицы с формулами, которые могут принимать значение пусто, а текущий способ распознаёт их как формулы.
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 19:17:55
Цитата
Kuzmich написал:
У вас цикл по листам (строковые переменные)Код ? 1For Each n In BazaListзачем n=n+1
Просто исключить данную строку?
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 18:01:45
Цитата
Kuzmich написал:
У вас Цитатагде n имя каждого листа из спискаа в макросе подразумевалось, что n - количество открываемых файлов
У меня:
i - элементы списка имен книг-источников;
n- элементы списка имен листов в каждом из источников.
В последней редакции кода макрос копирует данные с первого листа из списка и на записи n=n+1, т.е. переходе к следующему листу из списка, выдает ошибку, несмотря на то есть такой лист в списке или отсутствует.
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 17:47:48
Вот этот код срабатывает до строки n = n+1.
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iNameSht As String ' имя консолидируемого листа
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23")
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6")
       For Each i In BazaAdress
       'где i адрес каждого из файлов
       iTempFileName = i
            Do While iTempFileName <> ""
               With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each n In BazaList
                    ' где n имя каждого листа из списка
                    iNameSht = n
                            iLastRowTempWb = .Sheets(iNameSht).Cells(Rows.Count, 4).End(xlUp).Row
                            iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
                            .Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(5, 4), .Sheets(iNameSht).Cells(iLastRowTempWb, 14)).Copy
                            BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                    n = n + 1
                    Next
                   .Close saveChanges:=False
                End With
               Loop
        i = i + 1
        Next
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
   End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
Изменено: Александр - 27.07.2018 17:48:06
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 17:44:45
Попробовал, ругается
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 17:34:18
Ошибка 438, объект не поддерживает свойство или метод. Отрабатывает цикл при следующей формулировке кода и спотыкается на предпоследней строке. Может дело в том, что список состоит из одного имени листа и циклу нужен выход в случае ошибки?
Код
iNameSht = n
    iLastRowTempWb = .Sheets(iNameSht).Cells(Rows.Count, 4).End(xlUp).Row
    iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
    .Sheets(iNameSht).Range(.Sheets(iNameSht).Cells(5, 4), .Sheets(iNameSht).Cells(iLastRowTempWb, 14)).Copy
    BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    n = n + 1
Next

Изменено: Александр - 27.07.2018 17:34:37
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 17:21:20
В таком случае ругается на строку 2
Код
With .Worksheets(iNameSht).Activate
 iLastRowTempWb = .Cells(Rows.Count, 4).End(xlUp).Row
 iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
 .Sheets(iNameSht).Range(.Cells(5, 4), .Cells(iLastRowTempWb, 14)).Copy
 BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
End With
Изменено: Александр - 27.07.2018 17:21:44
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 17:06:50
Внес исправления, теперь ругается на 3 строку кода ниже:
Код
iLastRowTempWb = .Sheets(iNameSht).Cells(Rows.Count, 4).End(xlUp).Row
iLastRowBaza = BazaWb.Sheets(iNameSht).Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(5, 4), .Cells(iLastRowTempWb, 4)).Copy
BazaWb.Sheets(iNameSht).Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Изменено: Александр - 27.07.2018 17:07:33
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
27.07.2018 16:27:30
После длительных попыток отладки, макрос продолжает спотыкаться на строке  "iLastRowTempWb = iNameSht.Cells(Rows.Count, 3).End(xlUp).Row". Не могу придумать как в этой строке прописать имя листа, с которого данные должны быть скопированы.
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iNameSht As String ' имя консолидируемого листа
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23")
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6")
       For Each i In BazaAdress
       'где i адрес каждого из файлов
       iTempFileName = i
            Do While iTempFileName <> ""
               With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each n In BazaList
                    ' где n имя каждого листа из списка
                    iNameSht = n
                        With .Worksheets(iNameSht).Activate
                            iLastRowTempWb = iNameSht.Cells(Rows.Count, 3).End(xlUp).Row
                            iLastRowBaza = BazaWb.iNameSht.Cells(Rows.Count, 2).End(xlUp).Row + 1
                            .Range(.Cells(4, 1), .Cells(iLastRowTempWb, "*")).Copy
                             BazaWb.iNameSht.Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        End With
                    n = n + 1
                    Next
                   .Close saveChanges:=False
                End With
Изменено: Александр - 27.07.2018 16:28:10
 
Перейти    
Консолидация данных листов из списка в книгах из списка
 
#
25.07.2018 13:53:55
Добрый день!

Друзья, нужна ваша помощь. Стоит задача консолидировать данные листов, приведенных в списке, из 21 книги, адреса которых приведены также в списке и расположенных в разных папках, в соответствующие листы общего файла. На форуме нашел наиболее подходящий макрос, но знаний его модифицировать не хватает.
Код
Sub consolidation()
    Dim BazaWb As Workbook 'консолидирующая книга
    Dim BazaAdress As Range 'список адресов месторасположения файлов
    Dim BazaList As Range 'список консолидируемых листов
    Dim BazaSht As Worksheet 'консолидирующий лист
    Dim iTempFileName As String 'путь к файлам-источникам
    Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле по столбцу
    Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очередно открываемом файле по столбцу
    Dim iNumFiles As Long 'количество открываемых источников
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
       Set BazaWb = ThisWorkbook
       Set BazaAdress = BazaWb.Worksheets("Адрес").Range("D2:D23")
       Set BazaList = BazaWb.Worksheets("Адрес").Range("F2:F6")
       For Each i In BazaList
            iLastRowBaza = BazaWb.i.Cells(Rows.Count, 2).End(xlUp).Row + 1
                    .Range(.Cells(5, 2), .Cells(iLastRowBaza, "*")).Clear
       i = i + 1
       Next
       For Each i In BazaAdress
       iTempFileName = i
            Do While iTempFileName <> ""
               With .Workbooks.Open _
                    (Filename:=iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    'Рабочая книга не должна быть защищена паролем
                    For Each i In BazaList
                    With .i
                         iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row
                         iLastRowBaza = BazaWb.i.Cells(Rows.Count, 2).End(xlUp).Row + 1
                         .Range(.Cells(4, 1), .Cells(iLastRowTempWb, "*")).Copy
                         BazaWb.i.Cells(iLastRowBaza, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                         :=False, Transpose:=False
                    End With
                    i = i + 1
                    Next
                   .Close saveChanges:=False
                End With
              End If
        i = i + 1
        Next
       Loop
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
   End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
Дополнительно хотелось бы предусмотреть:
- возможность автоматического создания листа в консолидирующем файле, если в списке листов он есть, но фактически не создан;
- вставки буквенного обозначения предприятия, которому принадлежит информация.
Изменено: Александр - 26.07.2018 08:32:42 (Замечание модератора)
 
Перейти    
Страницы: 1 2 След.
Loading...