Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос д/сборки листов
 
Уважаемые форумчане!  
 
Нашел здесь макрос, который замечательно работает. Спасибо за это, как понимаю The_Prist'у.  
 
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  
       .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc  
   End With  
End Sub  
 
 
А вопрос такой - что в нем изменить, чтобы переносились только значения, без формул? К сожалению, в исходниках есть ссылки на другие литы (условные), которые, естественно, летят при копировании на один лист в совсем другие строки. Самому досконально разобраться в VBA совсем не хватает времени, к сожалению((  
Заранее благодарен.
Неполный импорт данные через MS Query
 
Добрый день!  
 
MS Query создает проблемы, если данные какого-то из полей могут быть похожи на определенные, но разные форматы. Мне необходимо получать данные из журнала регистрации входящей корреспонденции, в котором исходящие номера писем различных организаций имеют, разумеется, самый разный формат - от простого числа до сложной комбинации букв и символов. Query выбирает какое-то одно значение, которое ему больше понравилось)), и экспортирует в Excel только значения, которые, по его мнению, имеют аналогичный формат. В данном случае он выводит только числа, игнорируя все остальное. При этом формат ячеек в исходном файле и реципиенте - текстовый.  
Пробовал начинать выборку с даты, в которой первое значение - явно текстовое. Пустой номер(((.  
Интересней всего, что в окне запроса он также выводит не все, но все совсем другое!!!  
Как быть, чтобы запрос выдавал все, что находится в диапазоне? Сталкивался кто-нибудь.  
 
P.S. Прошлогодняя комбинация работала. Вероятно потому, что первые письма имели сложный формат номера, но были другие траблы - с полями дат. Если в ячейку вводились две даты, Query их также игнорировал. Так что это общая проблема квери, но я нигде не нашел упоминания о ней и способе решения.
Страницы: 1
Наверх