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

Страницы: 1 2 3 След.
Часы в ячейке с обновлением времени раз в полсекунды (то есть шли быстрее реальных)
 
New,  не получилось...ошибка синтаксиса
Изменено: Серёжа - 28.10.2021 15:20:50
Часы в ячейке с обновлением времени раз в полсекунды (то есть шли быстрее реальных)
 
Добрый день, на форуме есть как сделать часы в ячейке с обновлением раз в секунду, но вот как сделать чтоб часы обновляли время не раз в секунду а, например, раз в полсекунды (или в несколько сотен миллисекунд) (то есть чтоб шли быстрее реальных)
Код
Sub UpdateTime_real()
  Dim varNextCall As Variant   ' Записываем в ячейку текущее время
     Cells(1, 13).Value = Now  ' Записываем в varNextCall время, когда вызвать этот макрос в следующий раз (через 1 секунду)
     varNextCall = TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1) ' Уведомляем Excel в необходимости вызова макроса
     
     Cells(1, 14).Value = Now   ' Записываем в varNextCall время, когда вызвать этот макросв следующий раз (через 1 секунду)
     varNextCall = TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1) ' Уведомляем Excel в необходимости вызова макроса
End Sub
код взят с форума, ток немного поправлен под себя
Выделение дат за несколько дней до текущего дня включительно
 
Просто уже экспериментировал с разными формулами...думал что даты не правильно вычитаются без ДАТА(), но всё же не смог одолеть проблему с переходом УФ через конец месяца без помощи профессионалов))
Изменено: Серёжа - 11.06.2021 15:24:57
Выделение дат за несколько дней до текущего дня включительно
 
Спасибо)) оказалось все так просто, но я не догадался до такого.
Выделение дат за несколько дней до текущего дня включительно
 
это одна из формул которую редактировал, должно А3 быть(начало таблички), в самом УФ в файле формула с А3

Цель подсвечивать даты включая сегодня(). По сегодня() 4 дня (включая сегодня())  одним цветом, за несколько (5-7 дней до предыдущих 4х)  другим цветом. Извиняюсь если не очень понятно выразился)
и даты будут не подрядят а рандомно в табличке. подобно как в левой табличке в примере
Изменено: Серёжа - 11.06.2021 14:57:28
Выделение дат за несколько дней до текущего дня включительно
 
Добрый день, подскажите где кроется ошибка при условном форматировании с применение формулы? Не корректно работает условное форматирование на последних датах месяца, при окончании месяца часть форматирования пропадает, в начале следующего появляется.пример прилагаю в нем более подробно можно понять что не получается.
спасибо)
Изменено: vikttur - 11.06.2021 15:10:04
Условное форматирование: сравнения значений двух листов с выводом результата в третий
 
Хотелось бы видеть работу условного форматирования. Вот это работает но только в эксель 2010 и немного не так как хочется
Лист2!A1<Лист3!A1  если верно красим цвет1, если не верно не красим
Лист2!A1>Лист3!A1  если верно красим цвет2, если не верно не красим

хочется чтоб работало так но не только в эксель 2010 но и 2007 и ниже
Лист2!A1<(Лист3!A1-Лист1!M1) если верно красим цвет1, если не верно не красим
Лист2!A1>(Лист3!A1+Лист1!N1) если верно красим цвет2, если не верно не красим

или я НИЧЕГО не понимаю, что скорее всего
Изменено: Серёжа - 22.08.2019 23:24:48
Условное форматирование: сравнения значений двух листов с выводом результата в третий
 
Добрый день)
Необходимо сравнить значении таблиц на двух листах с выводом результата сравнения (в виде заливки ячеек) на третий лист.
всё это для эксель 2007 и/или ниже
пример в приложенном файле(ячейки лист1 закрашены в ручную)
на всяк добавлю пример и в 2010

в примере 2010 всё прекрасно работает, но если его открыть в 2007 то перестает
Изменено: Серёжа - 22.08.2019 23:23:25 (поменял файл пример 2010)
Перебор книг в папке из отдельной книги с макросом
 
Всем спасибо, разобрался с работой макроса из личной книги

тему наверное можно закрыть
Изменено: Серёжа - 18.06.2019 13:22:13
Перебор книг в папке из отдельной книги с макросом
 
Nordheim, спасибо. в итоге XLSTART нашлись все книги(листы) которые запускались, а сам Personal.xls (скорее всего сам так сохранил и не заметил) на другом диске, благо поиском нашлась.)) теперь работает.
Перебор книг в папке из отдельной книги с макросом
 
извиняйте если не в тему написал...в общем записал макрос в личную книгу и что то накосячил...теперь при открытии любой книги экселя запускаются чистые листы тех книг которые макрос должен был обрабатывать. я уже и макросы все удалил...осталось комп перезагрузить и офис переустановить((
Перебор книг в папке из отдельной книги с макросом
 
Спасибо, иду изучать личную книгу)
Копировать последний заполненный столбец на второй лист как значения
 
casag, всё работает, спасибо)

наверное можно закрывать тему
Перебор книг в папке из отдельной книги с макросом
 
Доброго времени, есть макрос который работает в нескольких книгах и соответственно находится в каждой. Имеется ли возможность оставить макрос только в одной книге и из неё обрабатывать несколько книг в папке? в интернете код нашёл но как туда свой(и любой другой) макрос прикрутить не понимаю.
код ниже взят с интернета, и даже указано куда вставить свой код...но(( не понимаю почему мой не работает

Код
 Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
    
    
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        
        'действия с файлом
        
        'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
        ActiveWorkbook.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub
Изменено: Серёжа - 17.06.2019 21:40:09
Копировать последний заполненный столбец на второй лист как значения
 
Спасибо, сделал чуть раньше по своему... но работает)) попробую Ваш код.
можно ещё вопрос  рядом с темой? как этот макрос запускать с другой книги(отдельно лежащей в папке) чтоб он книги во всей папке таким образом обрабатывал?

ниже то что уже работает

Код
Sub копирование_последнего_и_1справа_столбцов()
Dim lRow As Long 'переменная строки
Dim lCol As Long 'переменная столбика

lRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменная строки(получает номер последней не пустой строки)
    'Найти последнюю непустую ячейку в строке 6
lCol = Cells(6, Columns.Count).End(xlToLeft).Column 'переменная столбика(получает номер последнего не пустого столбца)

    
MsgBox "Последняя строка: " & lRow & vbNewLine & _
"Последний столбец: " & lCol

Range(Columns(lCol), Columns(lCol + 1)).EntireColumn.Select



    Range(Columns(lCol), Columns(lCol + 1)).EntireColumn.Copy
Sheets("имя_листа2").Select
Range("K1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("K1:L5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("K6:L200").Select
    Selection.Cut
    Range("C3").Select
    ActiveSheet.Paste
    Range("A1").Select
               
Application.DisplayAlerts = False
Filename = ThisWorkbook.Path & "\" & [A2] & ".xlsx"
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True

    Sheets("имя_листа").Select
    Range("A1").Select

   'Сообщение с результатом выполнения процедуры
   MsgBox "Файл успешно сохранен с названием - " & Filename, vbInformation, "Результат"

    
End Sub

Изменено: Серёжа - 16.06.2019 16:52:51
Копировать последний заполненный столбец на второй лист как значения
 
Добрый день, научите как поправить макрос.   Найти последний заполненный столбик и скопировать данные с него на второй лист как значения. Более подробно в примере, там же макрос который не совсем работает. спасибо)

Код
Sub копирование_последнего_и_1справа_столбцов()
Dim lRow As Long
Dim lCol As Long
lRow = Cells(Rows.count, 1).End(xlUp).Row
lCol = Cells(6, Columns.count).End(xlToLeft).Column

MsgBox "Последняя строка: " & lRow & vbNewLine & _
"Последний столбец: " & lCol

Range(Columns(lCol), Columns(lCol + 1)).EntireColumn.Select
Selection.Copy
'Range(Columns(lCol), Columns(lCol + 1)).EntireColumn.Copy
Sheets("имя_листа2").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'ActiveSheet.Paste


End Sub
Изменено: Серёжа - 16.06.2019 12:34:54
Открытие сроки защищенного листа для редактирования по условию.
 
Цитата
Так всё-таки, следующая или первая пустая?
чтоб активной стала первая пустая  в диапазоне С8:С100


Решено (взято с интернета)
Код
Sub dd()
  Range("C101").Activate
  On Error Resume Next
  Range("C8:C100").SpecialCells(xlCellTypeBlanks)(1).Activate
End Sub
Изменено: Серёжа - 15.02.2018 11:05:41
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
СПАСИБО добрым и терпеливым людям))

на данное время проблема решена только по поводу сохранения)), сообщение от Игоря Гончаренко (файл в #10) рабочий и взят за основу.
Моя книга содержит формулы и условные форматирования....в данное время формула ИНДЕКС+ПОИСКПОЗ не дает корректно использовать макрос (файл в #10)
буду искать чем заменить.
Изменено: Серёжа - 14.02.2018 11:54:16 (изменения в тексте)
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
как по другому картинку прикрепить не понял
предложенные изменения внёс в код
сохранённый файл с именем "пример" при этом находится в папке мои документы(его удаление ни как не сказывается)
Изменено: Серёжа - 13.02.2018 21:49:50
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
останов на WorkBook, переход на на первую строку, может я чего то не так делаю?
Код
myfile = File_path & "пример.XLS"
    Set wb = FindWorkBook(myfile)
    If Not wb Is Nothing Then wb.Close False
Изменено: Серёжа - 13.02.2018 20:50:18
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
Ігор Гончаренко
при открытой книге Kill myfile при останове подсвечено, ошибка не пропала((
Код
myfile = File_path & "пример.XLS"
    On Error Resume Next
    Worksheets(myfile).Close False
    On Error GoTo 0
    If Dir(myfile) <> "" Then Kill myfile
    ActiveWorkbook.SaveAs Filename:=myfile, _
Изменено: Серёжа - 13.02.2018 20:21:16
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
Ігор Гончаренко
Спасибо, работает.
теперь ещё бы обойти защиту от открытого файла (если файл открыт то требование закрыть файл), после закрытия продолжить макрос. Такое выполнимо?
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
Ігор Гончаренко
мне нужно чтоб ошибки при описанных действиях не возникало и работа макроса доходила до завершения
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
Ігор Гончаренко
Если я напишу в сторону где нет ошибки такое ведь не прокатит)))
1 вариант где ошибки нет при данном(скорректированом) коде
2 вариант где к имени приписывается время или порядковый номер (совсем без вопросов, можно с уведомлением где и с каким именем сохранилось)
3 вариант где игнорируются все попытки кроме как пересохранить с текущим именем с заменой(опять же можно  с уведомлением что удачно или нет)
ну и я почему то уверен что существует правильное решение о котором я пока что не знаю)))
надеюсь не напугал)
Макрос сохранения листа в отдельную книгу, подскажите где ошибка
 
При работе макроса на первый взгляд работает всё отлично, всё переносится и сохраняется(в папку мои документы) но это только в первый раз...если следом сразу снова запустить тот же макрос то он ругается на то что такое имя уже есть и при отказе(кнопка НЕТ или ОТМЕНА) тоже самое если согласится на замену файла и далее отказаться показывает окошко  с ошибкой. Как это исправить?
файлик прикладываю
 
Открытие сроки защищенного листа для редактирования по условию.
 
Юрий М, Исправил сообщение, извиняюсь что не сразу правильно их оформлял) по поводу Select читал в интернете но не всегда понимаю как без него назначить ячейку...да и мало вабще понимаю в макросах..

Михаил Лебедев, спасибо за файлик с кодом, все прекрасно работает. Ваш вопрос очень правильный(и чего я сам не подумал об этом), как вариант при смене имени обратно на мужское создам скрытую строку в самом начале листа(или на отдельном скрытом листе)  и буду её копировать(если конечно осилю копирование по условию)


извиняюсь если не в тему...а можно сюда как то прикрутить чтоб в конце работы макроса активировалась ячейка следующая за заполненной(то есть первая пустая)?
Изменено: Серёжа - 13.02.2018 19:23:01
Открытие сроки защищенного листа для редактирования по условию.
 
вот что смог самостоятельно сделать, хоть и работает но все же немного не так как хочется. что тут поправить чтобы макрос запускался сразу после появления данных в активной ячейке?



Код
[CODE]Sub Test1()
Dim Rng As Range, iVal As Variant 
    iVal = ActiveCell 
   Set Rng = Sheets("Лист3").Columns(1).Find(iVal, , xlFormulas, xlWhole)
   If Rng Is Nothing Then 
    MsgBox ""
    Exit Sub
   End If  
   Set TmpCell = ActiveCell
   TmpCell.Offset(0, -2).Select
   Selection.ClearContents
   Selection.Locked = False
   Selection.FormulaHidden = False
   TmpCell.Offset(0, -1).Select
   Selection.ClearContents
   Selection.Locked = False
   Selection.FormulaHidden = False
   TmpCell.Offset(0, 1).Select
   Selection.ClearContents
   Selection.Locked = False
   Selection.FormulaHidden = False
   TmpCell.Offset(0, 2).Select
   Selection.ClearContents
   Selection.Locked = False
   Selection.FormulaHidden = False
   TmpCell.Offset(0, 3).Select
   Selection.ClearContents
   Selection.Locked = False
   Selection.FormulaHidden = False
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
       , AllowInsertingRows:=True, AllowDeletingRows:=True
End Su
Изменено: Серёжа - 13.02.2018 18:23:51
Открытие сроки защищенного листа для редактирования по условию.
 
Лист наполнен формулами и защищён, надо разрешить редактирование строки по условию и удалить формулы. файлик прилагаю

записано рекордером
Код
'в этом месте надо как то вставить код чтоб он искал в списке женское имя и если находил то далее снятие защиты и ....
    ActiveSheet.Unprotect
    Range("A8:B8,D8:L8").Select
    Range("D8").Activate
    Selection.ClearContents
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("C9").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub[CODE][/CODE]
Изменено: Серёжа - 13.02.2018 18:25:08
как вставить данные в ячейку не содержащую формул?
 
спасибо за помощь!!!
в итоге принял в использование индекс+поискпоз так как ВПР тупил путая местами строки(так и не понял почему).
теперь осталось поправить формулу чтоб если соответствия нет то не выводило #Н/Д а просто оставалась ячейка пустой
как вставить данные в ячейку не содержащую формул?
 
Hugo, ВПР угодила)) но она (по моему мнению) не умеет вставлять данные не в ту ячейку где сама существует))
Страницы: 1 2 3 След.
Наверх