Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.07.2009, 10:28   #1
mephist
Форумчанин
 
Регистрация: 01.05.2009
Сообщений: 200
По умолчанию Сбор таблицы

Общая задача:
есть несколько листов, в которых внесены записи с 6 строки и до N-ой.
Мне нужно собрать все эти записи на один лист одни под другими(причем только надписи, то есть первые 5 строк листа не нужны).
N-неизвестно и на всех листах разное
С ходу меня останавливает вопрос, как определить N?
Код:
.Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[aN]
По логике вещей здесь вместо UsedRange должен быть UsedRange без первых пяти строк. А вместо аN должна быть последняя строка в которую производилось копарование +1. Можно это как-нибудь реализовать?
mephist вне форума Ответить с цитированием
Старый 17.07.2009, 10:39   #2
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Требуется уточнение.
Требуется скопировать из всех листов книги в один все данные со строки 6 до конца таблицы. Так?
1. Нужна именно копия (с форматами, формулами, границами, заливкой и т.п.), или достаточно только значений?
2. Диапазон UsedRange ограничивается не последней заполненной строкой, а последней использованной, т.е. если, например, на листе заполнены с 1-й по 10-ю строки, а границы ячеек прорисованы до 100-й строки, то ActiveSheet.UsedRange.Rows.Count будет 100. Поэтому, можно либо копировать весь диапазон, затем удалять пустые строки, либо в каждом листе определять последнюю заполненную строку.
Вам как нужно?
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 17.07.2009, 11:26   #3
mephist
Форумчанин
 
Регистрация: 01.05.2009
Сообщений: 200
По умолчанию

Цитата:
Сообщение от SAS888 Посмотреть сообщение
Требуется скопировать из всех листов книги в один все данные со строки 6 до конца таблицы. Так?
По сути да. Листы в разных книгах (но это не важно),а принцип совершенно верен(только желательно копировать дипазон B6:FN).
Цитата:
Сообщение от SAS888 Посмотреть сообщение
1. Нужна именно копия (с форматами, формулами, границами, заливкой и т.п.), или достаточно только значений?
Именно значения. Форматы будут только мешаться.
Цитата:
Сообщение от SAS888 Посмотреть сообщение
2. Диапазон UsedRange ограничивается не последней заполненной строкой, а последней использованной, т.е. если, например, на листе заполнены с 1-й по 10-ю строки, а границы ячеек прорисованы до 100-й строки, то ActiveSheet.UsedRange.Rows.Count будет 100. Поэтому, можно либо копировать весь диапазон, затем удалять пустые строки, либо в каждом листе определять последнюю заполненную строку.
Вам как нужно?
Там будет все хорошо, то есть граница будет проведена по последней заполненной строке.
Поэтому я думал копирнуть с UsedRange и удалить первые 5 строк. Вот только думаю, как сделать это красиво, то есть без промежуточных листов,гемороя и т.д. (может в VB есть еще одна волшебная функция???).
И самое главное, проверьте пожалуйста:
Код:
Sub asd
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "3 sz.xlsx")
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        N=ThisWorkbook.Worksheets(2).UsedRange.Rows.Count       
        .Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[a(N+1)]
        .Close False
    End With

    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "4 sz.xlsx")
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        N=ThisWorkbook.Worksheets(2).UsedRange.Rows.Count       
        .Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[a(N+1)]
        .Close False
    End With
End Sub
Я не знаю как реализуется присвоение переменных в VB, поэтому выделенное красным цветом писал наугад. Поправьте пожалуйста.
mephist вне форума Ответить с цитированием
Старый 17.07.2009, 11:58   #4
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

1. Вместо [a(N+1)] нужно использовать Cells(N + 1, "A").
2. Если в ThisWorkbook.Worksheets(2) нет пустых строк перед первой заполненной (другими словами, если данные в листе начинаются с 1-й строки), то все будет работать правильно. Если нет, то нужно использовать
Код:
With ThisWorkbook.Worksheets(2).UsedRange: N = .Row + .Rows.Count - 1: End With
3. Если нужны только значения, то нужно использовать:
Код:
Диапазон.Copy: Ячейка.PasteSpecial Paste:=xlPasteValues
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 17.07.2009, 15:15   #5
mephist
Форумчанин
 
Регистрация: 01.05.2009
Сообщений: 200
По умолчанию

Спасибо большое. ПРОСТО СУПЕР!
Вот, что у меня получилось:
Код:
   
     ThisWorkbook.Worksheets(10).Cells.Clear
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "sz.xlsx")
    With Workbooks.Open(Filename, , True)
        .Worksheets(13).Unprotect
        .Worksheets(13).UsedRange.Copy: ThisWorkbook.Worksheets(10).[a1].PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ThisWorkbook.Worksheets(10).Paste
        Application.CutCopyMode = False
        .Close False
    End With
    
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "mn.xlsx")
    With ThisWorkbook.Worksheets(10).UsedRange: N = .Row + .Rows.Count - 1: End With
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        .Worksheets(13).UsedRange.Copy ThisWorkbook.Worksheets(10).Cells(N + 1, "A")
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        .Close False
    End With
Буду очень рад любым коментам(они помогают познать VB)! спецвставку пока не стал реализовывать!
mephist вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сбор информации CraZZy RabbIt Общие вопросы Delphi 11 25.02.2009 01:00
Сбор данных OgE®_M@G Microsoft Office Excel 6 05.11.2008 05:57
Сбор и чтение пакета OrdJONY Работа с сетью в Delphi 1 17.09.2007 09:18
Сбор инфы с сайта. Mss_Smith Помощь студентам 6 17.06.2007 16:26