Добрый день, всем!  
 
Макрос, которого желательно автоматизировать является связь между блоками "BDа.xls"-база данных и "MatrixMnP.xls"-блок анализа.  
Вручную, рекордером сделал(часть кода прилагаю), но макрос получился жестко привязанный к конкретной странице.  
Хотелос бы его автоматизировать и сделать более универсальным, чтоб можно было его приложить и при добавлении на этой странице новые данные, и на других страницах, которые в примере не показал.  
   
Вот примерная логика макроса:  
1. По значении ячейки с адрессом: А1(Sheets("BD MN")), определяющее начало Первого диапазона, найти совпадение в колонки F:F.  
 
2. По значении ячейки с адрессом: А2(Sheets("BD MN")), определяющее конец Первого диапазона, найти совпадение в колонки F:F.  
 
3. По условию Down[т.е. если начальная строка содержить Down для выборки берем только строки, которые содержать UP, и наоборот:
если начальная строка содержить UP для выборки берем только строки, которые содержать Down](с адрессом: В1(Sheets("BD MN"))), взяв за начало 2-й строки Sheets("BD MN") выбрать все значения отвечающим    
условии UP, до конца Первого диапазона с колонки I:I и расположить их  в книге "MatrixMnP.xls", начиная с ячейки "F20" и дальше вниз.  
   Эти значения всегда расположены через одну строчку.  
 
4. Диапазоны не одинаковые по количество членов!  
 
5. Сценарии анализа зависит от условия начало(начальная строка) диапазона - Down (применяем Application.Run "MatrixMnP.xls!RANFJFJ02MnF"  
                                                                                            Application.Run "MatrixMnP.xls!Statistika9listovMnF)  
                                                                      или - UP   (применяем Application.Run "MatrixMnP.xls!RANFJFJ02MnFа"  
                                                                                            Application.Run "MatrixMnP.xls!Statistika9listovMnFа".  
 
6. Обработка страницы, в случае Sheets("BD MN"), заканчивается когда достигаем в колонки F:F до 0 или 1,    
(скорее до последней заполненной строке).  
   
Одно из решении вероятно будет - циклами.  
Один цикл = один диапазон.  
 
1.Начало первого цикла = А1(Sheets("BD MN"))  
  Конец первого цикла  = А2(Sheets("BD MN"))  
 
  Начало второго цикла = А2(Sheets("BD MN"))  
  Конец второго цикла  = А3(Sheets("BD MN"))...  
  Получается цепочка из связанных циклов.  
   
2.Циклы работают в колонке F:F.  
  Циклы обрабатывают разное количество ячеек, иногда только 2(начальная и конечная).  
 
  Сам вопрос: как сделать эту "цепочку из связанных циклов"?

Добрый день!  
 
На форуме нашел замечательный макрос, чуть переделал его:  
   
Sub ZamenyaetUkazannoeChisloNaSimvol()  
 
Range("E4:M18").Select  
Dim cur_range As Range  
With ActiveSheet  
Dim aa As Integer  
aa = "0" ' Заменяет найденное число на символ "*"  
Set cur_range = Selection  
cur_range.Activate  
For x = 1 To cur_range.Rows.Count  
For y = 1 To cur_range.Columns.Count  
If InStr(cur_range(x, y), aa) <> 0 Then cur_range(x, y).Value = "*"  
Next y  
Next x  
End With  
End Sub  
 
Но, макрос берет все числа в которых входит "0", например 40, а мне надо только "0" чтоб заменялась, наверное не до конца "модернизировал", оригинальный макрос был в теме:  
 
 http://www.planetaexcel.ru/forum.php?thread_id=16552&forumaction=newreplyquoted&post_id=128695&page_forum=lastpage&allnum_forum=11

Добрый вечер!:)  
   
 Задача этого макроса открыть файл типа .csv, преобразовать его в xlsm, потом скопировать диапазона:  
     "A1:D" - где в D последная занятая ячеяка увеличивает свой номер, т.е. столбец D - типа "динамический", если можно так выразиться.  
      Прочитав не мало страниц форума понравилось для этой цели:  
         
      Range("A1:D" & Cells(Rows.Count, 4).End(xlDown)).Copy  
         
      но, на этой строчке макрос затыкается и выдает ошибку:  
 
      Run-time error '1004':  
      Method 'Range' of object '.Global' failed.  
 
      Подскажите, как мне выти из этого положения?  
      Вот и сам макрос:  
         
Sub CSVXLSCOPY()  
     
     Workbooks.OpenText Filename:= _  
       "путь к файлу.csv", _  
       Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _  
       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _  
       Comma:=False, Space:=False, Other:=True, FieldInfo:=Array(Array(1, 1), _  
       Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True  
   Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  
       TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _  
       Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _  
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _  
       True  
   Columns("C:C").ColumnWidth = 15.38  
   Columns("D:D").NumberFormat = "0.0000"  
       Columns("D:D").Select  
       ActiveCell.FormulaR1C1 = "=ROUNDDOWN(C,4)"  
   ActiveWorkbook.SaveAs Filename:= _  
       "путь к файлу.xlsm", _  
       FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False  
     ActiveCell.End(xlDown).Select  
     Range("A1:D" & Cells(Rows.Count, 4).End(xlDown)).Copy  
   ActiveWindow.ScrollWorkbookTabs Position:=xlFirst  
   Sheets("Имя листа").Select  
   Range("P1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _  
       , SkipBlanks:=False, Transpose:=False  
   Range("P1").Select  
 
End Sub

Добрый день, всем!:)  
 
Решил модернизировать макрос:  
   
1. Чтоб включался при изменении значении в одной, определенной клетки.  
2. Чтоб срабатывал одновременно во всех листах книги, кроме одного - заглавного, он и первый.  
   
Вот сам макрос:  
   
Sub timeA07COOOa()  
 
Range("Q1:R1171").Select  
   Selection.ClearContents  
   Range("Q1").Select  
Range("OOO!E19").Copy  
Range("Q1").Select  
ActiveSheet.Paste  
Range("Q2:Q1171").FormulaR1C1 = _  
"=(RC[-1]-R[-1]C[-1])+R[-1]C+IF(AND(WEEKDAY((RC[-1]-R[-1]C[-1])+R[-1]C,2)=5,HOUR((RC[-1]-R[-1]C[-1])+R[-1]C)>=21),2,0)"
Range("R1").Select  
   ActiveCell.FormulaR1C1 = "=OOO!R19C5"  
Range("R2:R1171").FormulaR1C1 = "=IF(WEEKDAY(R1C[-1]:R1171C[-1],2)=6,RC[-1]+1.875,(RC[-2]-R[-1]C[-2])+R[-1]C)"
Range("Q1:R1171").NumberFormat = "dd/mm/yyyy hh:mm;@"  
Range("R1:R1171").Select  
   With Selection.Font  
       .Name = "Verdana"  
       .FontStyle = "обычный"  
       .Size = 8  
       .Strikethrough = False  
       .Superscript = False  
       .Subscript = False  
       .OutlineFont = False  
       .Shadow = False  
       .Underline = xlUnderlineStyleNone  
       .ThemeColor = xlThemeColorLight1  
       .TintAndShade = 0  
       .ThemeFont = xlThemeFontNone  
   End With  
Range("D1").Select  
End Sub  
 
Решил, включил поиск и начал смотреть как другие справились с такими задачами, в итоге вот, что вышло у меня:    
 
Sub timeA07COOOa()  
 
Range("Q1:R1171").Select  
   Selection.ClearContents  
   Range("Q1").Select  
Range("OOO!E19").Copy  
Range("Q1").Select  
ActiveSheet.Paste  
Range("Q2:Q1171").FormulaR1C1 = _  
"=(RC[-1]-R[-1]C[-1])+R[-1]C+IF(AND(WEEKDAY((RC[-1]-R[-1]C[-1])+R[-1]C,2)=5,HOUR((RC[-1]-R[-1]C[-1])+R[-1]C)>=21),2,0)"
Range("R1").Select  
   ActiveCell.FormulaR1C1 = "=OOO!R19C5"  
Range("R2:R1171").FormulaR1C1 = "=IF(WEEKDAY(R1C[-1]:R1171C[-1],2)=6,RC[-1]+1.875,(RC[-2]-R[-1]C[-2])+R[-1]C)"
Range("Q1:R1171").NumberFormat = "dd/mm/yyyy hh:mm;@"  
Range("R1:R1171").Select  
   With Selection.Font  
       .Name = "Verdana"  
       .FontStyle = "обычный"  
       .Size = 8  
       .Strikethrough = False  
       .Superscript = False  
       .Subscript = False  
       .OutlineFont = False  
       .Shadow = False  
       .Underline = xlUnderlineStyleNone  
       .ThemeColor = xlThemeColorLight1  
       .TintAndShade = 0  
       .ThemeFont = xlThemeFontNone  
   End With  
Range("D1").Select  
End Sub  
--------------------------------------------------------------------------------------  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Application.Intersect(Range("OOO!E19"), Target) Is Nothing Then Exit Sub  
Application.EnableEvents = False    
If [OOO!E19] Then Call [timeA07COOOa]
Application.EnableEvents = True    
End Sub  
 
Прописал макроса во всех листах, кроме заглавного, прописал эго и в "Эта книга".  
 
Но, не тут-то было, меняю значение в клетки "OOO!E19" и ничего не произходит, руки кривые, или скорее не докумекал что-то!:)  
   
Просьба, помогите исправить макрос.

Добрый день, всем!  
 
Есть в абсолютном смысле непрерывный рабочий процесс.    
Вписанный в календаре он прерывается, например в пятницу в 21:00    
и в 21:00 воскресенье возобновляется(момент перехода влияется от перехода рабочего     времени на  летнее\зимнее - в столбце В указал эти переходы, а в ячейки В63-66,    
подробнее разшифровал переход от 27.03.11 21:00).  
   
К определенному моменту, в нашем случае 08.04.11 8:32 (ячейка А1, в примере) прибавляются    
коэфициенты со столбца С (C1 по С1171) и получаем столбца D - формат ДАТА. Но в нем дата  
указана неправильно, потому что "переходы" в пятницу на воскресенье не включены.  
   
В столбца Е, вручную проставил эти переходы, для удобства выделил их цветом, вот они:  
   
Е315 - последный момент, уходящий пятницой.  
Е316 - первый момент в воскресенья.  
 
Е851 - последный момент, уходящий пятницой.  
Е852 - первый момент в воскресенья.  
 
Е1007 - последный момент, уходящий пятницой.  
Е1008 - первый момент в воскресенья.  
 
Е315 - последный момент, уходящий пятницой.  
Е316 - первый момент в воскресенья.  
   
Е1170 - последный момент, уходящий пятницой.  
Е1171 - первый момент в воскресенья.  
 
Как видно в столбце D процесс заканчивается 30.04.2011 07:13, а на самом деле 08.05.2011 07:13!  
Попробовал, как-то через вложенных "ЕСЛИ", решит проблемм формулой, но не получилось, опыта и знании не хватают!  
   
Еще важный момент, начало - что у нас в ячейке А1, может попасть в любой рабочий момент недели.  
 
Есть идей как справиться?:)

Добрый день!  
 В MSExcel 2010 есть замечательная вещь: "Найти и заменить", но не предусмотрено запись найденного результата в отдельный файл в табличном  или текстовом виде.  
 Еще вопрос, при включенном "Запись макроса" никакие действия по "Найти и заменить" не отоброжоються в записе, можно это как-то обойти. Хочется посмотреть как сделан код "Найти и заменить"?

Доброго времени суток, всем!  
Работаю в MSExcel 2010.  
 
Есть столбец  с 1200 строк, на одном из листе книги(например D). Тот-же самый столбец(D) есть и на осталных 14 листов. Каждой ячейке присвоено имя – уникальное в рамках книги(в имени заложена древовидная структура).  
Задача – как присвоить имена всем ячейкам столбца сразу(одним списком), а не ячейкой за ячейкой, и осталаным 14 листов(конечно изменив предварительно одного из элементов имени, для соблюдения уникальности имен  во всей книге)?  
Перепробовал все возможные варианты  в Диспетчере имен, но не дает именовать несколько ячеек сразу разными именами.