Страницы: 1
RSS
проблема с макросом по автоматическому объединению данных с нескольких книг
 
Всем добрый день. Есть такая проблема. Имеется огромное колиество книг, данные с которых нужно объединить в один лист. Вручную делать не вариант, большой объем. Хотел воспользоваться макросом(код будет приведен ниже), но, насколько я понимаю, когда вставляемые данные доходят до строки 65536, происходит ошибка, и процесс прекращается(версия экселя 2007). Вопрос такой: как можно обойти эту проблему?    
а) либо сделать так, что бы данные вставлялись после строки 65536  
б) либо после достижения строки 65546, автоматически осуществлялся переход на следующий лист  
в) либо есть другой способ о котором я не знаю.  
Подскажите пожалуйста  
 
Код VBA  
Sub Consolidated_Range_of_Books_and_Sheets()  
   Dim iBeginRange As Object, lCalc As Long  
   Dim sRngAddress As String, oAwb As String, sCopyAddress As String, sSheetName As String  
   Dim lLastRow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer  
   Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles  
 
   On Error Resume Next  
   Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _  
                                          "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _  
                                          vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)  
   If iBeginRange Is Nothing Then Exit Sub  
   sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")  
   If sSheetName = "" Then sSheetName = "*"  
   On Error GoTo 0  
   If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then  
       avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)  
       If VarType(avFiles) = vbBoolean Then Exit Sub  
       bPolyBooks = True  
   Else  
       avFiles = Array(ThisWorkbook.FullName)  
   End If  
   With Application  
       lCalc = .Calculation  
       .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual  
   End With  
   ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)  
   Set wsDataSheet = ThisWorkbook.ActiveSheet  
   For li = LBound(avFiles) To UBound(avFiles)  
       If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)  
       oAwb = Dir(avFiles(li), vbDirectory)  
       For Each wsSh In Workbooks(oAwb).Sheets  
           If wsSh.Name Like sSheetName Then  
               If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_  
               With wsSh  
                   Select Case iBeginRange.Count  
                   Case 1  
                       lLastRow = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                       iLastColumn = .Cells.SpecialCells(xlLastCell).Column  
                       sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastRow, iLastColumn)).Address  
                   Case Else  
                       sCopyAddress = iBeginRange.Address  
                       lLastRow = iBeginRange.Rows.Count  
                       iLastColumn = iBeginRange.Columns.Count  
                   End Select  
                   lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1  
                   sRngAddress = .Range(.Cells(lLastRowMyBook, 1), .Cells(lLastRowMyBook + lLastRow, iLastColumn)).Address  
                   .Range(sCopyAddress).Copy wsDataSheet.Range(sRngAddress)  
               End With  
           End If  
NEXT_:  
       Next wsSh  
       If bPolyBooks Then Workbooks(oAwb).Close False  
   Next li  
   With Application  
       lCalc = .Calculation  
       .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc  
   End With  
End Sub
 
[q]когда вставляемые данные доходят до строки 65536[/q]
А у Вас часом книга, куда вставляются эти данные не в формате 2003 (расширение xls - 65536 строк максимум - потому и ошибка)? Вставляйте в книгу в формате xlm, будет 1048576  
По второму вопросу у Вас есть переменная lLastRowMyBook, если она превысила допустимое количество строк - создавайте новый лист, переустанавливайте ссылку на неё в wsDataSheet и, соответственно, меняйте значение lLastRowMyBook
 
Извиняюсь, опечатка не xlm, а xlsx конечно, если книга с макросами, то xlsm
 
{quote}{login=anvg}{date=02.12.2011 07:42}{thema=}{post}Извиняюсь, опечатка не xlm, а xlsx конечно, если книга с макросами, то xlsm{/post}{/quote}  
 
Формат файлов xls, хотя чисто визуально число строк может продолжаться и далее. Файлы лежат на работу приду туда только в понедельник.
 
{quote}{login=anvg}{date=02.12.2011 07:40}{thema=}{post}  
По второму вопросу у Вас есть переменная lLastRowMyBook, если она превысила допустимое количество строк - создавайте новый лист, переустанавливайте ссылку на неё в wsDataSheet и, соответственно, меняйте значение lLastRowMyBook{/post}{/quote}  
 
Я в программировании вообще мало, что понимаю. Макрос был взят мной из гугла, и что там менять, я понимаю слабо. Если можно, подскажите, а лучше ткните носом туда, где нужно поменять и на что? У меня именно на компьютере стоит эксель 2003 и начальство менять на более современную версию отказывается. Поэтому может случиться так, что придется работать в 2003 экселе.
 
{quote}{login=The_Prist}{date=03.12.2011 05:35}{thema=}{post}Т.к. сам код написан мной, то разбираться мне недолго. На вскидку можно решить так:  
после этой строки:  
lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1  
 
добавьте:  
if lLastRowMyBook + lLastRow => 65536 then  
Set wsDataSheet = ThisWorkbook.Sheets.Add  
lLastRowMyBook = 2  
end if{/post}{/quote}  
 
Да код написан именно вами, там даже авторство есть которое я выкладывать не стал, спасибо, поробую
Страницы: 1
Читают тему
Наверх