Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Подсчет разницы времени в скобках в ячейке
 
Всем привет!  :)  
Необходимо получить общее время из интервалов в скобках.
Например v4-47156(01:37-02:23)+47160(23:47-00:04). В первой скобке 26 минут, во второй 17 минут. Итого 43 минуты.
Затруднение в расцеплении скобок, ладно если их две, а если три, или четыре.
И вообще есть сомнения, что такое можно сделать формулой.
Кто что скажет?
Еще раз о складе в excel, Списание товара со склада и накладных
 
Всем привет!
Эта тема много раз поднималась, но решил все же написать свой вопрос.
Ну не понимаю реально ли это реализовать в excel!?
Наткнулся на пример ведения склада в excel. Там смысл в том, что есть три листа: приход, расход и итог.
Решение простое, в итогах имеем перечень товара по позициям, напротив которых мы считаем суммы по полям прихода минус расхода.
Загвоздка в том, что нужно списывать товар с накладной.
Например, пришло товара 10, 5, 3 шт разных наименований по 1 накладной. Хочется видеть остаток каждого товара по этой накладной, ну и когда его 0 то мы знаем что накладную можно списать (в другой бух программе).
Немного сумбурно, конечно, но думаю смысл понятен.
Условное форматирование. Закрасить строку если в ней есть 7 пустых ячеек???
 
Всем добрый день!
Собственно вопрос:
Как закрасить строку если в ней есть 7 пустых ячеек??? (пример есть)
Затормозил на том, что вокруг таблицы пустых ячеек много и получается что все строки будут закрашиваться.
Вообще реально ли это сделать?
горизонтальный + вертикальный поиск
 
Добрый день, друзья!
Помогите пожалуйста с задачкой. Пытаюсь сделать отчет по приближению к ТО автомобилей.
Застрял на поиске последнего в строке значения.
2 проблемы:
1) поиск не видит числа более 2319, не понимаю почему?!
2) не получается организовать горизонтальный поиск с другого листа. Т.е. нужно вставлять последнее значение строки из другого листа по гос номеру. Не получается передать в формулу строку вида 4:4...
Подробности в примере.
Автоматический запуск надстройки
 
Еще раз всем привет!
Ребята, подскажите пожалуйста, как можно запускать надстройку (http://excelvba.ru/code/DropDownList) при открытии определенной книги?
Код заблокирован, поэтому его не внедрить в нужный файл.
Думаю, что следует при запуске "нужной" книги запускать эту надстройку.
Вариант с автозапуском при старте винды не очень подходит, т.к. файл может гулять в сети по юзерам.
Хотя может быть еще варианты про которые я не знаю...
Упрощение ввода данных с проверкой ввода данных
 
Всем привет!
Ребята, подскажите, как упростить ввод данных с проверкой ввода (например список).
Т.е. имеется 400 человек, если сделать проверку на ввод данных, то список будет внушительным и будет неудобно выбирать из него.
Хотелось бы вводить в ячейку руками и вываливался список с похожими.
Например вводишь "С" вываливается Самойлов Петр Сергеевич, Степных Георгий Иванович, Суриков Леонид Петрович
И потом мышкой выбираешь нужного.
Копирование листа (образца) и присвоение ему имени из диапазона ячеек VBA
 
Уважаемые форумчане, подскажите пожалуйста в решении такой задачи.

Есть список названий листов в некотором диапазоне ячеек на одном из листов (примерно 200 листов, вручную копировать муторно) о_О.
1) Как размножить лист (образец) с присвоением ему имени из диапазона ячеек с данными.
2) Если лист с таким названием есть, то пропуск копирования.

Нашел подобную тему, но затрудняюсь в некоторых моментах
нужен цикл перебора диапазона ячеек для создания листов
при копировании листа назначать имя из ячейки диапазона имен

Код
Sub qwe()
Dim wsSh As Worksheet
   On Error Resume Next

   For Each wsSh In ThisWorkbook.Sheets
      If wsSh.Name = Sheets("Лист" ;) .[A1] Then
         Msgbox "Есть уже такой"
         Exit Sub
      End if
   Next

   Set wsSh = Sheets("Лист" ;) .[A1]
   Sheets("Лист" ;) .Copy After:=Sheets(Sheets.Count)
   Sheets("Лист (2)" ;) .Name = Sheets("Лист" ;) .[A1]
End Sub
Перебор строк и замена содержимого ячейки по условию
 
Уважаемые форумчане, Добрый день!
Уже час бьюсь а результата - ноль.
Вроде все правильно, но не работает.
Нужно перебрать строки и если в 6 столбце значение ячейки равно 0, то присвоить ей "ttt".
Подскажите плз где туплю )
Код
Sub zamena()Dim i, lastRow As LonglastRow = Cells(Rows.Count, "A").End(xlUp).RowFor i = 2 To i = lastRow    If Cells(Rows(i), 6).Value = "0" Then    Cells(Rows(i), 6).Value = "ttt"    End If    Next iEnd Sub
Изменено: Sergey_85 - 14 фев 2013 11:51:29 (не правильное отображение кода)
Копирование всех листов из одной книги в другую VBA
 
Добрый день!
Уважаемые форумчане, подскажите с кодом.
Никак не могу найти код для копирования именно всех листов из одной книги в другую (открытую, где запускается код).
Нашел лишь копирование одного листа (


Sub copy()
Dim wb As Workbook
Set wb = Workbooks.Open("c:\temp\другая книга.xls", ReadOnly:=True)
wb.Sheets("лист который надо скопировать" ;) .Copy before:=ThisWorkbook.Sheets(1)
wb.Close False
End Sub
Поиск текста в ячейке Формула
 
Добрый день, товарищи!  
Нужна помощь в формуле, работает с ошибками. Своей головы только на такую хватило.  
Задача:  
В файл записываются примечания из другого файла (столбец F)  
В столбце Е должны подставляться "правильные" значения (РЕМОНТ, ПРОСТОЙ, на линии), т.к. эти значения потом подсчитываются в итогах, т.е. если там будут отличия, то итоги рассчитаются не верно. Вот здесь и нужна формула.    
Столбец G (временный) для отображения того как должно быть.  
"на линии" делать не обязательно, додумаю сам.  
Заранее спасибо.
VBA ругается на кавычки в формуле
 
Здравствуйте! Уважаемые форумчане.  
 
Вот код:    
 
Sub www()  
Range("AH2:AH" & Cells(Rows.Count, 1).End(xlUp).Row).Formula = "=IF(U2>T2,IF((U2-T2)<0.625,U2-T2," ")," ")"  
End Sub  
 
Ругается на ")," - в конце формулы.  
Догадываюсь, что формула читается как "=IF(U2>T2,IF((U2-T2)<0.625,U2-T2,"  
а остальное режется. Видимо проблема с синтаксисом формулы. Искал, но не нашел как  правильно ее записать.    
Подскажите плз как правильно пустоту вместо кавычек записать!?
Возможно ли упростить формулу?
 
Уважаемые форумчане, подскажите, возможно ли упростить формулу?  
=ЕСЛИОШИБКА(ЕСЛИ(ИНДЕКС(ДанныеGPS!$D$3:$D$3000;ПОИСКПОЗ($C4&G$1;(ДанныеGPS!$A$3:$A$3000)&(ДАТАЗНАЧ(ДЕНЬ(ДанныеGPS!$E$3:$E$3000)&"."&МЕСЯЦ(ДанныеGPS!$E$3:$E$3000)&"."&ГОД(ДанныеGPS!$E$3:$E$3000)));0))="стоянка";"P24";ЕСЛИ(ИНДЕКС(ДанныеGPS!$D$3:$D$3000;ПОИСКПОЗ($C4&G$1;(ДанныеGPS!$A$3:$A$3000)&(ДАТАЗНАЧ(ДЕНЬ(ДанныеGPS!$E$3:$E$3000)&"."&МЕСЯЦ(ДанныеGPS!$E$3:$E$3000)&"."&ГОД(ДанныеGPS!$E$3:$E$3000)));0))="нет данных";"Н/Д24";""));"")  
 
Если ее разобрать, то смысл такой : еслиошибка(если('ячейка в другой таблице'="стоянка";"P24";если('ячейка в другой таблице'="нет данных";"Н/Д24";""));"")
Добавление нового листа в книгу VBA
 
Уважаемые форумчане, никак не могу понять и найти: Как добавить новый лист в книгу  
 
Макрорекордером не понимаю как добавить и назначить сразу имя    
 
Sub Макрос1()  
   Sheets.Add After:=Sheets(Sheets.Count)  
   Sheets("Лист4").Select  
   Sheets("Лист4").Name = "Пусто"  
End Sub  
 
Какая команда должна быть, чтобы добавить лист с именем, без выделения?  
Вопрос наверно слишком простой, но прогуглив ничего не нашел. В основном все копируют листы.
Сложный поиск VBA
 
Есть данные (прикреплен файл). В файле перечисляются а/м (по гос номеру) в столбце А.  
Нужно найти а/м у которых в течение дня не было данных по открытию дверей, т.е. не было записей в строке с R по АА.  
Имеется макрос перебора файлов (данных по каждуму дню) с автофльтром. В данном случае автофильтр не помогает (в примере видно почему автофильтр не поможет).  
Уважаемые форумчане, помогите адаптировать существующий макрос для такого поиска.  
 
Option Explicit  
 
Sub Collect()  
 
Dim BazaWb As Workbook    'текущая книга (общий файл)  
   Dim BazaSht As Worksheet    'лист Price-group в общем файле  
   Dim iTempFileName As String    'имя поочерёдно открываемого файла  
   Dim iPath As String    'путь к папке, где лежат все файлы  
   Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце C  
   Dim iLastRowTempWb As Long    'последняя заполненная строка в по-очерёдно открываемом файле в столбце C  
   Dim iNumFiles As Long    'количество открываемых файлов  
 
   Dim lr&, rr As Range  
 
   With Application  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Calculation = xlManual  
       Set BazaWb = ThisWorkbook  
       Set BazaSht = BazaWb.Sheets("ДанныеGPS")  
       iPath = BazaWb.Path & "\Данные_по_GPS\"  
       iTempFileName = Dir(iPath & "*.xls")  
         
       Sheets("ДанныеGPS").Select 'обнуление данных gps  
       Range("A3:BA10000").Select  
       Selection.ClearContents  
         
       Do While iTempFileName <> ""  
           If iTempFileName <> BazaWb.Name Then  
               With .Workbooks.Open _  
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)  
                   iNumFiles = iNumFiles + 1  
                     
                   UserForm1.Label4.Caption = "Собирается информация по неисправностям МТ из файла:   " & iTempFileName  
                   UserForm1.Repaint  
                                       
                           'Рабочая книга не должна быть защищена паролем  
                   With .Worksheets(1)  
                       iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row  
                       iLastRowBaza = BazaSht.Cells(Rows.Count, 4).End(xlUp).Row + 1 'тут заменил 3 на 4!!! - не работало!  
                       '.Range(.Cells(3, 1), .Cells(iLastRowTempWb, "AA")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                         
                       '=======================  
                       lr = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                                 
                               If IsDate(Range("i8").Value) And Application.WorksheetFunction.IsText(Range("i8").Value) Then  
                               Range(.Cells(8, 9), .Cells(lr, 9)).TextToColumns  
                               End If  
                                 
                       With .Rows(7)  
                           '.AutoFilter Field:=4, Criteria1:="=нет данных"  
                           .AutoFilter Field:=9, Criteria1:=">23:00:00"  
                       End With  
                         
                       Set rr = Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _  
                                          .Range(.Cells(8, 1), .Cells(lr, "AA")))  
                       If Not rr Is Nothing Then rr.Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                       .Rows(7).AutoFilter ' а это и не обязательно - всё равно закрываем без сохранения  
                       '=======================  
                         
                   End With  
                   .Close saveChanges:=False  
               End With  
           End If  
           iTempFileName = Dir  
             
       Loop  
       .Calculation = xlAutomatic  
       .DisplayAlerts = True  
       .ScreenUpdating = True  
         
   End With  
   UserForm1.Label4.Caption = ""  
   UserForm1.Repaint  
   'MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"  
End Sub
Определение типа содержимого ячейки
 
Уважаемые форумчане, помогите разобраться.  
Перечитал много тем, но решения так и не нашел, может быть не понимаю.  
 
Есть ячейка с датой, но тип содержимого - "label".  
Вопрос: как проверить тип содержимого?  
 
Пробовал так:  
 
If IsNumeric(Range("I8")) = false then  
  Range("I8:I10000").TextToColumns  
 
Или так:  
If IsDate(Range("I8")) = true then  
  Range("I8:I10000").TextToColumns  
Но мне кажется что это не то, потому что texttocolums применяется в любом случае
Условное форматирование и соседняя ячейка (формула)
 
Уважаемые форумчане, подскажите формулу для условного форматирования, если конечно такое возможно.  
Нужно чтобы условное форматирование срабатывало на ячейку, при выполнении в ней условия и выполнения условия в предыдущей ячейки.  
В примере более наглядно.  
Пытался нагуглить, но ничего не нашел.
Не получается отфильтровать по времени
 
Уважаемые форумчане. Подскажите как правильно фильтровать по времени.  
Нужно найти все строки где время < 23:50:00  
 
Если указываю:  
.AutoFilter Field:=9, Criteria1:="23:50:00" то находит строку  
Если указываю:  
.AutoFilter Field:=9, Criteria1:="<23:50:00" то не находит вообще ничего  
Пробовал даже так:  
.AutoFilter Field:=9, Criteria1:="<0,998796296"
Заставка при открытии книги
 
Уважаемые форумчане. Подскажите пожалуйста. Никак не могу понять как реализовть заставку при открытии книги, чтобы она висела пока выполнялся макрос по сбору информации?! В тексте, который ниже, появляется заставка, но пока ее не закроешь макрос работать не будет.    
 
Private Sub Workbook_Open()  
 
Collect  
 
 
End Sub  
 
 
Макрос:  
Option Explicit  
Sub Collect()  
 
UserForm1.Show  
 
Dim BazaWb As Workbook    'текущая книга (общий файл)  
   Dim BazaSht As Worksheet    'лист Price-group в общем файле  
   Dim iTempFileName As String    'имя поочерёдно открываемого файла  
   Dim iPath As String    'путь к папке, где лежат все файлы  
   Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце C  
   Dim iLastRowTempWb As Long    'последняя заполненная строка в по-очерёдно открываемом файле в столбце C  
   Dim iNumFiles As Long    'количество открываемых файлов  
 
   Dim lr&, rr As Range  
 
   With Application  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Calculation = xlManual  
       Set BazaWb = ThisWorkbook  
       Set BazaSht = BazaWb.Sheets("ДанныеGPS")  
       iPath = BazaWb.Path & "\Данные_по_GPS\"  
       iTempFileName = Dir(iPath & "*.xls")  
         
       Sheets("ДанныеGPS").Select 'обнуление данных gps  
       Range("A3:BA1000").Select  
       Selection.ClearContents  
         
       Do While iTempFileName <> ""  
           If iTempFileName <> BazaWb.Name Then  
               With .Workbooks.Open _  
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)  
                   iNumFiles = iNumFiles + 1  
                   'Рабочая книга не должна быть защищена паролем  
                   With .Worksheets(1)  
                       iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row  
                       iLastRowBaza = BazaSht.Cells(Rows.Count, 4).End(xlUp).Row + 1 'тут заменил 3 на 4!!! - не работало!  
                       '.Range(.Cells(3, 1), .Cells(iLastRowTempWb, "AA")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                         
                       '=======================  
                       lr = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                       With .Rows(7)  
                           .AutoFilter Field:=4, Criteria1:="=нет данных"  
                           .AutoFilter Field:=9, Criteria1:="=24:00:00"  
                       End With  
                       Set rr = Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _  
                                          .Range(.Cells(8, 1), .Cells(lr, "AA")))  
                       If Not rr Is Nothing Then rr.Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                       .Rows(7).AutoFilter ' а это и не обязательно - всё равно закрываем без сохранения  
                       '=======================  
                     
                   End With  
                   .Close saveChanges:=False  
               End With  
           End If  
           iTempFileName = Dir  
       Loop  
       .Calculation = xlAutomatic  
       .DisplayAlerts = True  
       .ScreenUpdating = True  
   End With  
 
   UserForm1.Hide  
 
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"  
End Sub
Помогите разобраться с кодом VBA
 
Когда файлы лежат там же где и эта книга, то поиск данных и ее заполнение работает.  
Немного изменил код, дописав "Данные_по_GPS\" в:            
iPath = BazaWb.Path & "\Данные_по_GPS\"  
Теперь данные не вставляются, а перебор работает. Знаю что ерундовая ошибка, где то забыл что то наверно.  
 
 
 
Option Explicit  
 
Sub CollectInfo()  
   Dim BazaWb As Workbook    'текущая книга (общий файл)  
   Dim BazaSht As Worksheet    'лист Price-group в общем файле  
   Dim iTempFileName As String    'имя поочерёдно открываемого файла  
   Dim iPath As String    'путь к папке, где лежат все файлы  
   Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце C  
   Dim iLastRowTempWb As Long    'последняя заполненная строка в по-очерёдно открываемом файле в столбце C  
   Dim iNumFiles As Long    'количество открываемых файлов  
 
   Dim lr&, rr As Range  
 
   With Application  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Calculation = xlManual  
       Set BazaWb = ThisWorkbook  
       Set BazaSht = BazaWb.Sheets("Price-group")  
       iPath = BazaWb.Path & "\Данные_по_GPS\"  
       iTempFileName = Dir(iPath & "*.xls")  
       Do While iTempFileName <> ""  
           If iTempFileName <> BazaWb.Name Then  
               With .Workbooks.Open _  
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)  
                   iNumFiles = iNumFiles + 1  
                   'Рабочая книга не должна быть защищена паролем  
                   With .Worksheets(1)  
                       iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row  
                       iLastRowBaza = BazaSht.Cells(Rows.Count, 4).End(xlUp).Row + 1 'тут заменил 3 на 4!!! - не работало!  
                       '.Range(.Cells(3, 1), .Cells(iLastRowTempWb, "AA")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                         
                       '=======================  
                       lr = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                       With .Rows(7)  
                           .AutoFilter Field:=4, Criteria1:="=нет данных"  
                           .AutoFilter Field:=9, Criteria1:="=24:00:00"  
                       End With  
                       Set rr = Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _  
                                          .Range(.Cells(8, 1), .Cells(lr, "AA")))  
                       If Not rr Is Nothing Then rr.Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                       .Rows(7).AutoFilter ' а это и не обязательно - всё равно закрываем без сохранения  
                       '=======================  
                     
                   End With  
                   .Close saveChanges:=False  
               End With  
           End If  
           iTempFileName = Dir  
       Loop  
       .Calculation = xlAutomatic  
       .DisplayAlerts = True  
       .ScreenUpdating = True  
   End With  
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"  
End Sub
VBA Копирование данных в лист из закрытой книги
 
Уважаемые гуру, нужен макрос которые копирует при открытии текущей книги диапазон данных (А1:H50) из закрытой книги (путь постоянный) с листа2 в текущюю в лист3, но сначала очищает в текущей лист3.
Поиск во всех книгах (в одной папке) нужной информации VBA
 
Всем привет.  
Помогите пожалуйста с кодом макроса для поиска строк по критериям и записи в текущую книгу.    
Есть макрос который собирает все данные из всех книг в текущей папке - как основа.  
Например, нужно чтобы в эту книгу собирались строки из всех книг в папке, где значние в ячейке d (Статус) = "нет данных", а в ячейке I (Длительность) = 24:00:00.  
Такой код очень нужен. Т.к. потом его можно использовать для поиска других данных.
Вопрос по грамотной организации отчета.
 
Есть две таблицы с данными(Разные файлы).    
Таблица А (200 строк и 31 столбец):  
В ней в столбцах дни месяца, а в строках гос номера. На пересечении строк и столбцов буковки которые отображают состояние а/м.  
Таблица Б (примерно 100 строк, примерно 10 столбцов):  
В ней данные в строках, гос номера, дата, состояние.  
Таблица С (еще один файл) в который хотелось бы грузить данные из таблицы А и Б.  
 
Когда данные находятся в книге вместе с таблицей С, все работает, иногда тормозит, но работает.  
Вот две формулы которые подтягивают данные из двух таблиц:  
=ИНДЕКС(Лист3!$H$5:$BA$1100;ПОИСКПОЗ($C3;Лист3!$D$5:$D$1100;0);ПОИСКПОЗ(F$1;Лист3!$H$4:$BA$4;0))  
=ИНДЕКС(GPS!$G$1:$G$1000;ПОИСКПОЗ($C3&F$1;GPS!$A$1:$A$1000&GPS!$B$1:$B$1000;0))  
 
Но когда указываешь пути к файлам, откуда брать значения, то ексель зависает,получается что эти формулы растягиваешь 200*60 ячеек.  
Может быть у меня здесь не тот подход?!
Ошибка в формуле по двумерному поиску
 
Уважаемые форумчане, помогите найти ошибку в формуле.  
Не верно находит значение при двумерном поиске.  
В лист 1 должны вставляться данные из листа 3. Формула отмечена зеленым.
User-defined type not defined - в чем проблема?
 
Доброго времени суток.    
Скажу сразу что новичек.  
Помогите разобраться.  
Нашел макрос по фильтрации, но при выполнении ругается на:  
 
Sub SimpleSheetFilter()  
     
               As New com.sun.star.Sheet.TableFilterField  
 
 
КОД:  
Sub SimpleSheetFilter()  
   Dim oSheet ' Лист, на котором применен фильтр.  
   Dim oFilterDesc ' Критерии фильтра.  
   Dim oFields(0) As New com.sun.star.Sheet.TableFilterField  
   
   oSheet = ThisComponent.getSheets().getByIndex(0)  
   
   oFilterDesc = oSheet.createFilterDescriptor(True)  
   
   With oFields(0)  
       .Field = 5 ' Filter column F.  
       .IsNumeric = True ' Используется числовое значение  
       .Operator = com.sun.star.Sheet.FilterOperator.GREATER  
       .NumericValue = 4 ' Значения больше 4  
   End With  
   oFilterDesc.setFilterFields (oFields())  
   oSheet.Filter (oFilterDesc)  
End Sub
Страницы: 1
Наверх