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

Страницы: 1
А как объединить эти два макроса в один?
 
Sub m_1()  
Dim i As Long  
For i = 1 To 10000 ' количество ячеек в моей таблице  
 
 
Application.FindFormat.MergeCells = True  
Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate  
 
 
If TypeName(Selection) <> "Range" Then Exit Sub  
If Selection.Cells.Count <= 1 Then Exit Sub  
Dim i%, iCell As Range, ActRng As Range  
Dim ActSh As Worksheet, TempSh As Worksheet  
Dim lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row  
Dim lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1  
If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1  
Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol)))  
Application.ScreenUpdating = False: Application.DisplayAlerts = False  
Set ActSh = ActiveSheet: Set TempSh = Sheets.Add ' запомнить текущую и создать новую страницу  
ActRng.Copy TempSh.Range(ActRng.Address)  
ActSh.Activate  
Selection.UnMerge  
For i = 2 To ActRng.Cells.Count ' заполнить Selection формулами-ссылками на первую ячейку  
ActRng(i).Formula = "=" & ActRng(1).Address  
ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart ' сделать ссылки перемещаемыми  
Next  
TempSh.Range(ActRng.Address).Merge  
TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete  
Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing  
Application.ScreenUpdating = True: Application.DisplayAlerts = True  
     
Next i  
End Sub  
 
 
 
может так??
А как объединить эти два макроса в один?
 
Возможна ли это процедура?
А как объединить эти два макроса в один?
 
у меня есть макрос, который правильно объединяет ячейки (в основном при работе с фильтрами),  
у меня есть макрос, который находит объединенные ячейки,  
у меня есть файл с более чем 20 000 неправильно объединенными ячейками.  
как создать цикл, который бы все эти ячейки правилно объединил.  
 
макросы прилагаются  
((((((ПРАВИЛЬНАЯ ГРУППИРОВКА))))))  
SUB ReMerge() ' перегруппировать сгруппированную ячейку или сгруппировать ячейки выделенного диапазона с заполнением скрытых ячеек формулами-ссылками на первую ячейку    
IF TypeName(Selection) <> "Range" THEN EXIT SUB    
IF Selection.Cells.Count <= 1 THEN EXIT SUB    
DIM i%, iCell AS Range, ActRng AS Range    
DIM ActSh AS Worksheet, TempSh AS Worksheet    
DIM lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row    
DIM lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1    
IF lLastRow > Selection.Row + Selection.Rows.Count - 1 THEN lLastRow = Selection.Row + Selection.Rows.Count - 1    
Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol)))    
Application.ScreenUpdating = False: Application.DisplayAlerts = False    
 
Set ActSh = ActiveSheet: Set TempSh = Sheets.Add ' запомнить текущую и создать новую страницу    
ActRng.Copy TempSh.Range(ActRng.Address)    
ActSh.Activate    
Selection.UnMerge    
FOR i = 2 TO ActRng.Cells.Count ' заполнить Selection формулами-ссылками на первую ячейку    
ActRng(i).Formula = "=" & ActRng(1).Address    
ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart ' сделать ссылки перемещаемыми    
NEXT    
TempSh.Range(ActRng.Address).Merge    
TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete    
Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing    
Application.ScreenUpdating = True: Application.DisplayAlerts = True    
END SUB  
 
 
((((((((((((ПОИСК ОБЪЕДИНЕННЫХ ЯЧЕЕК))))))))))))))  
 
 
SUB MCells()  
Application.FindFormat.MergeCells = True  
Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate  
END SUB  
 
 
 
(((((ПРИБЛИЗИТЕЛЬНЫЙ ЦИКЛ))))))))))  
 
0 ПОВТОРИТЬ ПОКА НЕ ДОСТИГЛИ КОНЦА ТАБЛИЦЫ  
1 ПОИСК ЯЧЕЙКИ  
2 ПРИМЕНЕНИЕ МАКРОСА  
 
 
Я, к сожалению не знаю синтаксиса(
Автофильтр по объединенным ячейкам. Как вывести все соседние ячейки (строки)?
 
а можно сделать, что бы все объединенные ячейки в файле он объединил по формату REMERGE?  
 
просто у меня 7000 строк
Импорт данных из excel документов
 
а как сделать так, чтобы  
 
в файле источнике в столбе X строке Y брались данные,  
 
потом в другом файле в столбе X1 сверялось с данными и если в строке Y1 оно сошлось, то бралось бы значение из столба Z1 строки Y1    
 
и вставлялось бы в файл источник в столб Z строку Y?
Импорт данных из excel документов
 
кстати надстройки PLEX & MyAddin  не одно и то же?
Импорт данных из excel документов
 
нет все таки задача не решенной осталась  
 
Извините, сразу не заметил, что здесь нужно подписываться.  
 
 
У меня вопросы:  
1. Как можно указывать несколько диапазонов?  
2. Как указать конечную ячейку для конкретной начальной?  
3. Как работать с тем моментом, что диапазон изменяется?
Импорт данных из excel документов
 
кое-что по макросам я знаю  
трудность состоит в том, что диапазон ячеек разный в разных файлах.    
 
я так понял, что использовать надо    
 
Sub Main()  
Dim myPath As String, myName As String, i As Integer  
With Application.FileDialog(msoFileDialogFolderPicker)  
.Title = "Укажите рабочую папку": .Show  
If .SelectedItems.Count = 0 Then Exit Sub  
myPath = .SelectedItems(1) & "\"  
End With  
Application.ScreenUpdating = False: myName = Dir(myPath & "*.xls"): i = 1: Cells.ClearContents  
Do While myName <> ""  
Cells(i, 2).Formula = "='" & myPath & "[" & myName & "]Лист1'!$C$5"
Cells(i, 3).Formula = "='" & myPath & "[" & myName & "]Лист1'!$D$8"
Cells(i, 1) = myName: i = i + 1: myName = Dir  
Loop: [A:C].Value = [A:C].Value
End Sub  
 
 
можно ли написать макрос, где постоянно бы открывался следующий документ из директории, где я бы уже выбирала диапазон ячеек, где есть нужные данные.
Импорт данных из excel документов
 
Расположение всех остальных ячеек полностью одинаковое. ЗЫ Само содержание ячеек разное.  
вязи между конечным файлом и файлом-источником не нужны. Нужны только цифры, данные. ='[1.xls]Лист1'!R20C4 - этими связями я просто показал, что откуда берется.
 
В папке определенное количество файлов, новые не появляются.
Импорт данных из excel документов
 
Уважаемые форумчане,  
 
помогите пожалуйста решить задачу, очень похожую на ту, что обсуждается в этой ветке. Проблема в том, что я вообще не разбираюсь в программировании.  
 
Вобщем, имеется куча .xls файлов в одной папке.  
на листе 1 находится нужная информация.  
 
Требуется собрать всю информацию с этих файлов в один .xls для последующего анализа.    
(1.xls - пример документов, ИЗ которых берется информация. желтым обозначены ячейки нужные. Проблема в том, что в диапазоне R32C3 - R40C17 в разных файлах меняется количество строк, соответственно и расположение ячеек. изменяется от 1 до 7 строк обычно.  
2.xls - это таблица, которая должна получиться, В которую вставляются данные).    
 
Заранее благодарю за оказанную помощь!  
 
У меня Excel 2007.  
Некоторая информация указана в примечаниях.(R-Row- строка,С-column-столбец)  
Для удобства столбцы, которые не требуются в заполнении скрыты.
Страницы: 1
Loading...