Добрый день, на форуме есть как сделать часы в ячейке с обновлением раз в секунду, но вот как сделать чтоб часы обновляли время не раз в секунду а, например, раз в полсекунды (или в несколько сотен миллисекунд) (то есть чтоб шли быстрее реальных)
Код
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
Просто уже экспериментировал с разными формулами...думал что даты не правильно вычитаются без ДАТА(), но всё же не смог одолеть проблему с переходом УФ через конец месяца без помощи профессионалов))
это одна из формул которую редактировал, должно А3 быть(начало таблички), в самом УФ в файле формула с А3
Цель подсвечивать даты включая сегодня(). По сегодня() 4 дня (включая сегодня()) одним цветом, за несколько (5-7 дней до предыдущих 4х) другим цветом. Извиняюсь если не очень понятно выразился) и даты будут не подрядят а рандомно в табличке. подобно как в левой табличке в примере
Добрый день, подскажите где кроется ошибка при условном форматировании с применение формулы? Не корректно работает условное форматирование на последних датах месяца, при окончании месяца часть форматирования пропадает, в начале следующего появляется.пример прилагаю в нем более подробно можно понять что не получается. спасибо)
Хотелось бы видеть работу условного форматирования. Вот это работает но только в эксель 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, если не верно не красим
Добрый день) Необходимо сравнить значении таблиц на двух листах с выводом результата сравнения (в виде заливки ячеек) на третий лист. всё это для эксель 2007 и/или ниже пример в приложенном файле(ячейки лист1 закрашены в ручную) на всяк добавлю пример и в 2010
в примере 2010 всё прекрасно работает, но если его открыть в 2007 то перестает
Изменено: Серёжа - 22.08.2019 23:23:25(поменял файл пример 2010)
Nordheim, спасибо. в итоге XLSTART нашлись все книги(листы) которые запускались, а сам Personal.xls (скорее всего сам так сохранил и не заметил) на другом диске, благо поиском нашлась.)) теперь работает.
извиняйте если не в тему написал...в общем записал макрос в личную книгу и что то накосячил...теперь при открытии любой книги экселя запускаются чистые листы тех книг которые макрос должен был обрабатывать. я уже и макросы все удалил...осталось комп перезагрузить и офис переустановить((
Доброго времени, есть макрос который работает в нескольких книгах и соответственно находится в каждой. Имеется ли возможность оставить макрос только в одной книге и из неё обрабатывать несколько книг в папке? в интернете код нашёл но как туда свой(и любой другой) макрос прикрутить не понимаю. код ниже взят с интернета, и даже указано куда вставить свой код...но(( не понимаю почему мой не работает
Код
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
Спасибо, сделал чуть раньше по своему... но работает)) попробую Ваш код. можно ещё вопрос рядом с темой? как этот макрос запускать с другой книги(отдельно лежащей в папке) чтоб он книги во всей папке таким образом обрабатывал?
ниже то что уже работает
Код
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
Добрый день, научите как поправить макрос. Найти последний заполненный столбик и скопировать данные с него на второй лист как значения. Более подробно в примере, там же макрос который не совсем работает. спасибо)
Код
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
на данное время проблема решена только по поводу сохранения)), сообщение от Игоря Гончаренко (файл в #10) рабочий и взят за основу. Моя книга содержит формулы и условные форматирования....в данное время формула ИНДЕКС+ПОИСКПОЗ не дает корректно использовать макрос (файл в #10) буду искать чем заменить.
Изменено: Серёжа - 14.02.2018 11:54:16(изменения в тексте)
как по другому картинку прикрепить не понял предложенные изменения внёс в код сохранённый файл с именем "пример" при этом находится в папке мои документы(его удаление ни как не сказывается)
Ігор Гончаренко при открытой книге 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, _
Ігор Гончаренко Спасибо, работает. теперь ещё бы обойти защиту от открытого файла (если файл открыт то требование закрыть файл), после закрытия продолжить макрос. Такое выполнимо?
Ігор Гончаренко Если я напишу в сторону где нет ошибки такое ведь не прокатит))) 1 вариант где ошибки нет при данном(скорректированом) коде 2 вариант где к имени приписывается время или порядковый номер (совсем без вопросов, можно с уведомлением где и с каким именем сохранилось) 3 вариант где игнорируются все попытки кроме как пересохранить с текущим именем с заменой(опять же можно с уведомлением что удачно или нет) ну и я почему то уверен что существует правильное решение о котором я пока что не знаю))) надеюсь не напугал)
При работе макроса на первый взгляд работает всё отлично, всё переносится и сохраняется(в папку мои документы) но это только в первый раз...если следом сразу снова запустить тот же макрос то он ругается на то что такое имя уже есть и при отказе(кнопка НЕТ или ОТМЕНА) тоже самое если согласится на замену файла и далее отказаться показывает окошко с ошибкой. Как это исправить? файлик прикладываю
Юрий М, Исправил сообщение, извиняюсь что не сразу правильно их оформлял) по поводу Select читал в интернете но не всегда понимаю как без него назначить ячейку...да и мало вабще понимаю в макросах..
Михаил Лебедев, спасибо за файлик с кодом, все прекрасно работает. Ваш вопрос очень правильный(и чего я сам не подумал об этом), как вариант при смене имени обратно на мужское создам скрытую строку в самом начале листа(или на отдельном скрытом листе) и буду её копировать(если конечно осилю копирование по условию)
извиняюсь если не в тему...а можно сюда как то прикрутить чтоб в конце работы макроса активировалась ячейка следующая за заполненной(то есть первая пустая)?
вот что смог самостоятельно сделать, хоть и работает но все же немного не так как хочется. что тут поправить чтобы макрос запускался сразу после появления данных в активной ячейке?
Код
[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
Лист наполнен формулами и защищён, надо разрешить редактирование строки по условию и удалить формулы. файлик прилагаю
записано рекордером
Код
'в этом месте надо как то вставить код чтоб он искал в списке женское имя и если находил то далее снятие защиты и ....
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]
спасибо за помощь!!! в итоге принял в использование индекс+поискпоз так как ВПР тупил путая местами строки(так и не понял почему). теперь осталось поправить формулу чтоб если соответствия нет то не выводило #Н/Д а просто оставалась ячейка пустой