Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос для копирования таблиц без учета скрытых строк. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для копирования таблиц без учета скрытых строк. (Макросы/Sub)
Макрос для копирования таблиц без учета скрытых строк.
Exsodus Дата: Четверг, 06.10.2022, 10:52 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Добрый день. Нужен помощь в написании макроса. Будет книга с множеством листов, на листах будут таблицы, значения в которых будут браться из другой таблицы. Макрос будет проверять значения в ячейках столбца «С» и если оно нулевое, то скрывать данные строки. Макрос в написании которого мне нужна помощь должен копировать таблицы без учета скрытых строк с листов «1.1 , 1.2 , 1.3 , 1.4 , 2.1 , 2.2» с сохранением условного форматировании и по возможности с сохранением ширины строк и столбцов на лист2. Таблица с листа 1.1 должна копироваться на лист2 в ячейку «В2», с листа 1.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 1.1 со смещением в одну строку и т.д. Таблица с листа 2.1 должна копироваться на лист2 в ячейку «F2», с листа 2.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 2.1 со смещением в одну строку и т.д. Так как в таблице на листе 1.4 все значения равны 0, то она копироваться не должна. Значения равные 0 могут быть в любой таблице, нужна проверка, что заполнена ячейка «С6». Также прошу помощи в проверке макроса, который я нашел и переделал немного под себя. Он работает нормально, если только имеется значение в первом столбце. Пример прилагаю. Можете ли вы помочь с написанием макроса? Спасибо.
К сообщению приложен файл: 0492792.xlsm(29.0 Kb)
 
Ответить
СообщениеДобрый день. Нужен помощь в написании макроса. Будет книга с множеством листов, на листах будут таблицы, значения в которых будут браться из другой таблицы. Макрос будет проверять значения в ячейках столбца «С» и если оно нулевое, то скрывать данные строки. Макрос в написании которого мне нужна помощь должен копировать таблицы без учета скрытых строк с листов «1.1 , 1.2 , 1.3 , 1.4 , 2.1 , 2.2» с сохранением условного форматировании и по возможности с сохранением ширины строк и столбцов на лист2. Таблица с листа 1.1 должна копироваться на лист2 в ячейку «В2», с листа 1.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 1.1 со смещением в одну строку и т.д. Таблица с листа 2.1 должна копироваться на лист2 в ячейку «F2», с листа 2.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 2.1 со смещением в одну строку и т.д. Так как в таблице на листе 1.4 все значения равны 0, то она копироваться не должна. Значения равные 0 могут быть в любой таблице, нужна проверка, что заполнена ячейка «С6». Также прошу помощи в проверке макроса, который я нашел и переделал немного под себя. Он работает нормально, если только имеется значение в первом столбце. Пример прилагаю. Можете ли вы помочь с написанием макроса? Спасибо.

Автор - Exsodus
Дата добавления - 06.10.2022 в 10:52
Exsodus Дата: Пятница, 07.10.2022, 10:03 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Никто не знает, как сделать или с таким макросом только платно делать?
 
Ответить
СообщениеНикто не знает, как сделать или с таким макросом только платно делать?

Автор - Exsodus
Дата добавления - 07.10.2022 в 10:03
Kuzmich Дата: Пятница, 07.10.2022, 15:34 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 702
Репутация: 154 ±
Замечаний: 0% ±

Excel 2003
Цитата
Макрос для копирования таблиц без учета скрытых строк.

[[vba]
Код
Sub MacrosCopyWithoutHidden()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Wsh As Worksheet
Dim List2 As Worksheet
  Set List2 = ThisWorkbook.Worksheets("Лист2")
     List2.Cells.Clear                    'очищаем Лист2
   For Each Wsh In Worksheets                       'цикл по листам, кроме Лист2
    If Wsh.Name <> "Лист2" Then
     With Wsh
       If Left(Wsh.Name, 1) = "1" Then
         iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
         If iLR >= 6 Then
           iLastRow = List2.Cells(Rows.Count, "B").End(xlUp).Row + 2
           .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy
           List2.Cells(iLastRow, 2).PasteSpecial xlPasteColumnWidths
           List2.Cells(iLastRow, 2).PasteSpecial xlPasteAll
         End If
       Else
          iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
         If iLR >= 6 Then
           iLastRow = List2.Cells(Rows.Count, "F").End(xlUp).Row + 2
           .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy
           List2.Cells(iLastRow, 6).PasteSpecial xlPasteColumnWidths
           List2.Cells(iLastRow, 6).PasteSpecial xlPasteAll
         End If
       End If
     End With
    End If
   Next
     List2.Activate
     List2.Range("A1").Activate
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
Макрос для копирования таблиц без учета скрытых строк.

[[vba]
Код
Sub MacrosCopyWithoutHidden()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Wsh As Worksheet
Dim List2 As Worksheet
  Set List2 = ThisWorkbook.Worksheets("Лист2")
     List2.Cells.Clear                    'очищаем Лист2
   For Each Wsh In Worksheets                       'цикл по листам, кроме Лист2
    If Wsh.Name <> "Лист2" Then
     With Wsh
       If Left(Wsh.Name, 1) = "1" Then
         iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
         If iLR >= 6 Then
           iLastRow = List2.Cells(Rows.Count, "B").End(xlUp).Row + 2
           .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy
           List2.Cells(iLastRow, 2).PasteSpecial xlPasteColumnWidths
           List2.Cells(iLastRow, 2).PasteSpecial xlPasteAll
         End If
       Else
          iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
         If iLR >= 6 Then
           iLastRow = List2.Cells(Rows.Count, "F").End(xlUp).Row + 2
           .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy
           List2.Cells(iLastRow, 6).PasteSpecial xlPasteColumnWidths
           List2.Cells(iLastRow, 6).PasteSpecial xlPasteAll
         End If
       End If
     End With
    End If
   Next
     List2.Activate
     List2.Range("A1").Activate
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 07.10.2022 в 15:34
msi2102 Дата: Пятница, 07.10.2022, 16:55 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 248
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007
Ещё вариант
В именах листов должен быть разделитель "," и начинаться они должны с числа
[vba]
Код
Sub Copyr()
    Dim pst As Range, cop As Range, ws As Worksheet, r1 As Integer, r2 As Integer, s As Variant
    Range("A:L").Clear
    For Each ws In ActiveWorkbook.Worksheets
        s = Split(ws.Name, ",")
        If UBound(s) > 0 Then
            r1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
            Set cop = ws.Range("B2:D" & r1)
            If cop.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Or cop.Rows.Count > 4 Then
                r2 = Worksheets("Лист2").Cells(Rows.Count, (s(0) + (s(0) - 1) * 3) + 1).End(xlUp).Row + 2
                Set pst = Worksheets("Лист2").Cells(r2, (s(0) + (s(0) - 1) * 3) + 1)
                cop.SpecialCells(xlCellTypeVisible).Copy Destination:=pst
                Application.CutCopyMode = False
            End If
        End If
    Next
End Sub
[/vba]
К сообщению приложен файл: 8954907.xlsm(39.2 Kb)
 
Ответить
СообщениеЕщё вариант
В именах листов должен быть разделитель "," и начинаться они должны с числа
[vba]
Код
Sub Copyr()
    Dim pst As Range, cop As Range, ws As Worksheet, r1 As Integer, r2 As Integer, s As Variant
    Range("A:L").Clear
    For Each ws In ActiveWorkbook.Worksheets
        s = Split(ws.Name, ",")
        If UBound(s) > 0 Then
            r1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
            Set cop = ws.Range("B2:D" & r1)
            If cop.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Or cop.Rows.Count > 4 Then
                r2 = Worksheets("Лист2").Cells(Rows.Count, (s(0) + (s(0) - 1) * 3) + 1).End(xlUp).Row + 2
                Set pst = Worksheets("Лист2").Cells(r2, (s(0) + (s(0) - 1) * 3) + 1)
                cop.SpecialCells(xlCellTypeVisible).Copy Destination:=pst
                Application.CutCopyMode = False
            End If
        End If
    Next
End Sub
[/vba]

Автор - msi2102
Дата добавления - 07.10.2022 в 16:55
Exsodus Дата: Пятница, 07.10.2022, 18:56 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Range("A:L").Clear
Здравствуйте, спасибо. А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"? Макрос может запускаться с других листов. И можно ли указать диапазон очистки, вверху у меня шапка с описанием будет. Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения? Спасибо.


Сообщение отредактировал Exsodus - Пятница, 07.10.2022, 19:37
 
Ответить
Сообщение
Range("A:L").Clear
Здравствуйте, спасибо. А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"? Макрос может запускаться с других листов. И можно ли указать диапазон очистки, вверху у меня шапка с описанием будет. Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения? Спасибо.

Автор - Exsodus
Дата добавления - 07.10.2022 в 18:56
Kuzmich Дата: Пятница, 07.10.2022, 22:29 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 702
Репутация: 154 ±
Замечаний: 0% ±

Excel 2003
Цитата
А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"?

В моем коде есть ответ на ва вопрос
 
Ответить
Сообщение
Цитата
А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"?

В моем коде есть ответ на ва вопрос

Автор - Kuzmich
Дата добавления - 07.10.2022 в 22:29
msi2102 Дата: Понедельник, 10.10.2022, 08:40 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 248
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007
Если нужно очистить весь лист, то
[vba]
Код
Worksheets("Лист2").Cells.Clear
[/vba]
Если нужно очистить определенный диапазон именно на определенном листе то так: "Range("A:L")" можете заменить на нужный Вам диапазон, например Range("A1:L10")
[vba]
Код
Worksheets("Лист2").Range("A:L").Clear
[/vba]
Если напишите так
[vba]
Код
Worksheets("Лист2").Range("A1:L10").Clear
[/vba]
то будет очищать не столбцы целиком, а только диапазон "A1:L10"
Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения

Почитайте справку UsedRange
Попробуйте запустить макрос ниже, со значением в первом столбце и без оного, и посмотрите, что он будет выделять
[vba]
Код
Sub Test()
    ActiveSheet.UsedRange.Select
End Sub
[/vba]
Замените строку Вашего кода
[vba]
Код
    For Each cell In Sheets(i).UsedRange.Columns(3).Cells
[/vba]
на
[vba]
Код
    For Each cell In Application.Intersect(Sheets(i).UsedRange, Sheets(i).Columns(3))
[/vba]
К сообщению приложен файл: 2169134.xlsm(41.6 Kb)


Сообщение отредактировал msi2102 - Понедельник, 10.10.2022, 08:43
 
Ответить
СообщениеЕсли нужно очистить весь лист, то
[vba]
Код
Worksheets("Лист2").Cells.Clear
[/vba]
Если нужно очистить определенный диапазон именно на определенном листе то так: "Range("A:L")" можете заменить на нужный Вам диапазон, например Range("A1:L10")
[vba]
Код
Worksheets("Лист2").Range("A:L").Clear
[/vba]
Если напишите так
[vba]
Код
Worksheets("Лист2").Range("A1:L10").Clear
[/vba]
то будет очищать не столбцы целиком, а только диапазон "A1:L10"
Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения

Почитайте справку UsedRange
Попробуйте запустить макрос ниже, со значением в первом столбце и без оного, и посмотрите, что он будет выделять
[vba]
Код
Sub Test()
    ActiveSheet.UsedRange.Select
End Sub
[/vba]
Замените строку Вашего кода
[vba]
Код
    For Each cell In Sheets(i).UsedRange.Columns(3).Cells
[/vba]
на
[vba]
Код
    For Each cell In Application.Intersect(Sheets(i).UsedRange, Sheets(i).Columns(3))
[/vba]

Автор - msi2102
Дата добавления - 10.10.2022 в 08:40
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для копирования таблиц без учета скрытых строк. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!