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

Страницы: 1 2 3 След.
Суммирование Дат с учётом Рабочего времени и выходных
 
Что касаемо формулы , то можно так (для ечейки E8):
Код
=ЕСЛИ(ЧАС(РАБДЕНЬ(C8;(ОСТАТ(C8;1)-$B$16+D8)/$B$17)+$B$16+ОСТАТ(ОСТАТ(C8;1)-$B$16+D8;$B$17))<13;РАБДЕНЬ(C8;(ОСТАТ(C8;1)-$B$16+D8)/$B$17)+$B$16+ОСТАТ(ОСТАТ(C8;1)-$B$16+D8;$B$17);РАБДЕНЬ(C8;(ОСТАТ(C8;1)-$B$16+D8)/$B$17)+$B$16+ОСТАТ(ОСТАТ(C8;1)-$B$16+D8;$B$17)+ВРЕМЯ(1;0;))


Что касаемо вопросо о времени, то можно пользоваться фугкциями Час(), МИНУТЫ(), СЕКУНДЫ().

Пример:
Код
ЕСЛИ(Час(Е8)>=13; Е8+1/24; Е8+0/24)
Как очистить память после Rows.Delete, После выполнения Rows.delete, используемая Екселем память увеличивается примерно в два раз
 
Hugo,

Спасибо!
Расчет количества дней отпуска, Количество причитающихся дней отпуска на текующую дату
 
Цитата
imax пишет:
за каждый полный месяц(1,25 при 15 днях отпуска и 2 при 24 днях)

Кол-во дней отпуска за один месяц составляет 2,33 дня, при этом отпускные расчитываются с учетом дробной части, к примеру за есть за 6 месяц работы полагается 13,98. При этом каждый конкретный отработанный день можно так же пересчитать в дни отпуска.

Про 15 дней отпуска и 1,25 не понял, поэтому ниже формула для расчета дней отпуска исходя из положенных 28 дней в год.

Формула для подсчета общего кол-ва дней отпуска между двумя датами:
Цитата
=ОТБР((РАЗНДАТ(C12;C17;"m"))/12)*28+(РАЗНДАТ(C12;C17;"m")-ОТБР((РАЗНДАТ(C12;C17;"m"))/12)*12)*2,33+ЕСЛИ(ДЕНЬ(C12)<>ДЕНЬ(C17);(РАЗНДАТ(ДАТАМЕС(C12;РАЗНДАТ(C12;C17;"m"));C17;"d")/30)*2,33;0)
Получить список всех объявленных переменных из кода, NopePad++ и Locals Window не предлогать :)
 
Памяти хватает, хотя железо встречается разное и бывает удивляет своей "новизной" ;)

Интересен сам принцип подобного обращения к переменным зная только имя переменной, которое хранится ввиде текстовой строки.
Как очистить память после Rows.Delete, После выполнения Rows.delete, используемая Екселем память увеличивается примерно в два раз
 
Нашел еще один вариант решения:

В место строки
Код
WsR.Rows(j + 1 & ":" & j + 1).Delete Shift:=xlUp

и последующих
Код
With WsR.UsedRange: End With
' или
ur=WsR.UsedRange


Можно использовать
Код
WsR.UsedRange.Rows(j + 1 & ":" & j + 1).Delete Shift:=xlUp
Изменено: SkyShark - 13.03.2013 10:10:47
Получить список всех объявленных переменных из кода, NopePad++ и Locals Window не предлогать :)
 
Я тоже знаю, или стараюсь знать и понимать, но дело ни в этом.

Моих знаний просто не хватает что бы решить эту задачу, и даже не знаю в каком направлении искать решение. Можете считать это навязчивой идеей, но хочется все таки найти способ реализации :)
Получить список всех объявленных переменных из кода, NopePad++ и Locals Window не предлогать :)
 
Может не совсем корректно выразился. Код не завершается, а идет ожидание действий пользователя при этом все переменные продолжают существовать и как результат занимают память. Конечно можно не обращать внимания скажем на переменные byte, long, Boolean и т. д. при текущих гигобайтных объемах памяти, но все таки это не совсем правильно.

Плюс ко всем, чем не вариант проверки всех переменных и скажем в случае обнаружения в памяти: 4-х объектов, 5-ти целых и 8-и строковых переменных объявленных и не очищенных в результате работы кода, завершить программу или выдать сообщение.
Получить список всех объявленных переменных из кода, NopePad++ и Locals Window не предлогать :)
 
Спасибо за ответ!

На сколько смог понять, Вы предлагаете изначально все переменные создавать как элементы словаря, правильно? В любом случае идея интересная и точно пригодится, но не в данном случае.

Предположим, что это не возможно, то есть мы не можем изменить текущий код и даже не знаем имена всех переменных.
Единственное что можем это либо предложенный мной вариант получения списка имен ввиде текста, либо другие варианты о которых я не знаю.

Может что то из WinAPI? ... Хотя на сколько я понял обратиться к переменной напрямую в память по имени нельзя...
Изменено: SkyShark - 01.03.2013 23:49:33
Запрет сохранения изменений при закрытии книги.
 
RAN,

Действительно, есть такая проблема :)

Спасибо за подсказку;)
Запрет сохранения изменений при закрытии книги.
 
RAN,

В моей связке все отрабатывало нормально, проблем не заметил, да и книгу нельзя сохранить даже "SaveAs".

Но если нужно оставить эту возможность, можно заменить строку Cancel = True на Cancel = SaveAsUI + 1
Запрет сохранения изменений при закрытии книги.
 
Вот только сохранить этот код в книге, будет не просто  ;)  
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub


.... но с помощью breakpoint можно ;)

Этот код нужно разместить в коде Книги, тогда нажатие на сохранить - будет игнорироваться, а при закрытии сохраняться без внесеных изменений.
Изменено: SkyShark - 01.03.2013 15:16:30
Получить список всех объявленных переменных из кода, NopePad++ и Locals Window не предлогать :)
 
Добрый День!

Искал и по этому форуму и в гугле, но ни чего к сожалению не нашел :(
Вопрос такой, есть скажем в модуле объявленные переменные допустим:

Код
Public WsR as Worksheet
Public i as Integer, j as Long, s as String


К примеру требуется перед завершением выполнения кода получить список всех переменных и очистить их.

Все что смог сделать, это получить имена переменых в текстовом виде.
А вот как обратиться к переменной зная ее текстовое имя или как получить список всех переменных виде самих же переменных, или как очистить/удалить из памяти эту переменную зная ее имя, вот с этим разобраться не могу.
Помогите, пожалуйста! ... кто чем может :)

пример моего кода:
Код
Public WsPD As Worksheet
Public Folder2 As Folder
Public NedStart As Date, NedFin As Date
Public z As Byte, FVS As Byte, RN As Byte
Public MagArr()

Sub test()

'Получаем список всех модулей, форм, листов и т.д. в данной книге
For Each iVBcomponent In ThisWorkbook.VBProject.VBComponents
    'Проверяем являеться ли модулем или формой
    If iVBcomponent.Type = 1 Or iVBcomponent.Type = 3 Then
        'Построчно просматриваем часть модуля с объявленными переменными
        For i = 1 To iVBcomponent.CodeModule.CountOfDeclarationLines
            'Разделям по ","
            x = Split(iVBcomponent.CodeModule.Lines(i, 1), ",")
            'просматриваем получившиеся части
            For j = 0 To UBound(x)
                'Разделям по " " и выбираем переменную
                x1 = Split(x(j), " ")(1)

'**********************************************************************
'Выделенная часть на данный момент не имеет смысла, так как x1 всегда будет string содержащий имя переменной

                Debug.Print x1, TypeName(x1)
                'определяем тип переменной
                Select Case VarLife(x1)
                    Case 1
                        Set x1 = Nothing
                    Case 2
                        Erase x1
                    Case 3
                        x1 = ""
                End Select
'*********************************************************************
            Next j
        Next i
    End If
Next

End Sub

Function VarLife(curVariables As Variant) As Byte
    If IsObject(curVariables) Then VarLife = 1: Exit Function
    If IsArray(curVariables) Then VarLife = 2: Exit Function
    VarLife = 3
End Function

Поиск заданного значения в каждом листе, с последующим копированием листа в новую книгу
 
К тому же вот так писать тоже не следует Workbooks(bkNew) Вы ведь раньше уже объявили Dim bkNew As Excel.Workbook

В итоге код должен выглядить примерно так:
Код
Sub FindKeyWord()

Dim book As Excel.Workbook  'переменная книги
Dim h As Byte '(листов в одной книге больше чем 255 вроде быть не может) / но можно заменить на integer если у Вас все же встречаются
'Dim bkOtchet As Excel.Workbook 'в Вашем коде ни где не используется, можно удалить
Dim bkNew As Excel.Workbook

On Error Resume Next
For Each book In Workbooks 'проверяем каждую книгу
    For h = 1 To book.Sheets.Count  'определяем кол-во листов в книге и последовательно перебираем
        'If book.Sheets(h).Cells(1, 11) Like "*KEY_WORD*" Then   'ищу в ячейку K1 значение KEY_WORD
            'на случай если нужных значений в листах найдено не будет, новую книгу создаем только после нахождение первого значения
            If bkNew Is Nothing Then 'проверяем что новая книга не существует
                Set bkNew = Workbooks.Add 'добавляем новую книгу и запоминаем ее
            End If
            book.Sheets(h).Move Before:=Workbooks(bkNew).Sheets(1)      'копируем лист в котором была найдена ячейка K1 с идентичным значением в созданную книгу bkNew перед 1ый листом
            bkNew.Sheets(1).Range("K1").FormulaR1C1 = "PAPI"  'переименовываю значение ячейки K1 чтобы не вызвать циклического повторения опереации
        'End If
    Next h
Next

End Sub
Изменено: SkyShark - 21.02.2013 17:56:55
моргание экрана при работе макроса
 
Добавить в начала и в конец кода отключение и включение обновления экрана.

Код
Sub ....()

Application.ScreenUpdating = False

...Ваш Код

Application.ScreenUpdating = True

End Sub
Изменено: SkyShark - 20.02.2013 11:44:45
Набор критериев для формирования массива по CheckBox
 
Если необходимо формировать t согласно CheckBox, то можно попробовать вот так:

Код
t = Empty
If CheckBox1 = True Then t = t & a(i, l2) & "|"
If CheckBox2 = True Then t = t & a(i, l8) & "|"
If CheckBox3 = True Then t = t & a(i, l7) & "|"
If CheckBox4 = True Then t = t & a(i, l20) & "|"
If CheckBox5 = True Then t = t & a(i, l21) & "|"
If Len(t) > 0 Then t = Left(t, Len(t) - 1)
Изменено: SkyShark - 18.02.2013 13:55:34
Выбор диапазона для обработки, Не работает добавление "формы выбора диапазона" (Application.InputBox(Type:=8))
 
Цитата
Юрий пишет:
А точка наверное относится к «ThisWorkbook.Worksheets(1)»?

Именно так  :)
Выбор диапазона для обработки, Не работает добавление "формы выбора диапазона" (Application.InputBox(Type:=8))
 
Цитата
Юрий пишет:
Set iRangeComments = .rFormulasRng.SpecialCells(xlComments)

Уберите точку перед rFormulasRng и все будет работать.

Цитата
Юрий пишет:
разницу между Range=Range и Range=.Range
.ставиться когда данный параметр используется совместно с With

Код
With Thisworkbook.Sheets(2)
   Range=.Range
End with
'тоже самое что и
Range=Thisworkbook.Sheets(2).Range


В вашем коде как раз в этом и была проблема, так как rFormulasRng является отдельно объявленной переменной, а чуть выше используется With ThisWorkbook.Worksheets(1) и так как как у Worksheets нету свойства/метода и т.д. называемого rFormulasRng это и проводило к ошибке.


Что касается вот этого кода:
Код
z =Range("H8:H10")
Set iRangeComments = .z.SpecialCells(xlComments)


То сейчас он конечно уже не нужен, но правильней указать вот так:
Код
z =.Range("H8:H10")
Set iRangeComments = z.SpecialCells(xlComments)
Изменено: SkyShark - 11.02.2013 13:30:33
Кнопки в ячейках для воспроизведения mp3
 
Можно воспроизводить звук через API, это если без внедрения файлов в книгу.

Объявляем API функцию
Код
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long


Ну и в своей процедуре пишем:
Код
Call mciExecute("play " & "test.mp3")


Ни каких всплывающих окошков нет, кнопки управления можно размесить на UserForm или прямо на листе...
Изменено: SkyShark - 11.02.2013 10:39:47
Копирование всех листов из одной книги в другую VBA
 
Код
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
wb.Sheets.copy before:=ThisWorkbook.Sheets(1)
For Each ws In wb.Sheets
   ws.copy before:=ThisWorkbook.Sheets(1)
Next
wb.Close False
Set wb = Nothing

End Sub


Поздно изменил, вернул как было :)
Изменено: SkyShark - 08.02.2013 18:01:17
Вычислить номер страницы для использования в СЧЕТЕСЛИМН, Необходимо вычислить номер страницы для корректной работы функции СЧЕТЕСЛИМН
 
Цитата
Alex пишет:
чтобы было примерно "итого по стр.1 8998,29 руб."  ;)  .

Если нужно Итого по стронице, то наверно можно обойтись только записью формулы в одну ячейку.

Цитата
Alex пишет:
достаточно изменить вид формулы

Да, только необходимо учитывать переменные firstCellHb и lastCellHB, так как они отвечаю за первую и последню строку каждой странийцы.
Изменено: SkyShark - 08.02.2013 13:59:52
Вычислить номер страницы для использования в СЧЕТЕСЛИМН, Необходимо вычислить номер страницы для корректной работы функции СЧЕТЕСЛИМН
 
Если заполнение формулой с учетом страниц, то вот так можно

Код
Public Sub PageNumner()
Dim HPB As Excel.HPageBreak
Dim firstCellHb As Long
Dim lastCellHB As Long

firstCellHb = 10
lastCellHB = 0

For Each HPB In ActiveSheet.HPageBreaks
    lastCellHB = HPB.Location.Row - 1
    ActiveSheet.Range("J" & firstCellHb & ":J" & lastCellHB).FormulaR1C1 = "=SUMIF(R" & firstCellHb & "C7:R" & lastCellHB & "C7,"">0"")"
    firstCellHb = lastCellHB + 1
Next

If lastCellHB < ActiveSheet.UsedRange.Rows.Count Then
    lastCellHB = ActiveSheet.UsedRange.Rows.Count
    ActiveSheet.Range("J" & firstCellHb & ":J" & lastCellHB).FormulaR1C1 = "=SUMIF(R" & firstCellHb & "C7:R" & lastCellHB & "C7,"">0"")"
End If

End Sub
Перевернуть страницу
 
А как насчет выложить пример файла, что бы было понятно какие области и как должны выводиться на печать...

или поиграйтесь вот с этим:
Код
'Диапозон который будет выведен на печать в книжном варианте
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$G$16"
        .Orientation = xlLandscape
    End With
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
    'Диапозон который будет выведен на печать в альбомном варианте
    With ActiveSheet.PageSetup
        .PrintArea = "$A$17:$K$32"
        .Orientation = xlPortrait
    End With
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Изменено: SkyShark - 08.02.2013 11:47:45
Создание массива в макросе
 
А в какой момент проверяет и куда вводят данные?
Если на листе и только в одном месте то можно и формулами обойтись:)
Не работает цикл удаления строк в коде
 
Код
 ElseIf WS.Cells(i2, 1).Value = "Гамлин" And WS.Cells(i2, 2).Value <> "Гамлин"


Наверно потому что, WS.Cells(i2, 1).Value должно быть равно "Апельсин"
Создать и упростить таблицу
 
А в каком виде поступает информация которую Вам необходимо заносить в таблицу, списки по проектам, по видам работ или по мастерам? Проекты будут появляться новые это Вы указали, а к примеру виды работ будут меняться и сколько их? Это необходимо понимать так как, чем удобней вносить данные, тем меньше вероятность ошибки и больше скорость работы, если все это в ручном режиме вносится конечно.
Как сделать так, чтобы макрос работал на всех ПС?
 
Находите в коде это строку, выделяете мышкой
Код
ThisWorkbook.Path & "\Банк изображений\" & Target.Name
, без ChDir!!!, нажимаете на выделенном правой кнопкой мышки и выбираете Add Watch... В появившемся окне выбираете Break then Value Changes.

После этого всего возращаетесь на лист и кликаете по гиперссылки, дальше думаю будет все видно.

и еще вопрос.... А диск всегда один и тот же? ..... можно еще по пробовать перед ChDir, использовать ChDrive

Код
ChDrive (Left(ThisWorkbook.Path, 1))
    ChDir ThisWorkbook.Path & "\Банк изображений\" & Target.Name
Изменено: SkyShark - 06.02.2013 17:20:19
Как сделать так, чтобы макрос работал на всех ПС?
 
Цитата
Марина пишет:

а где проверить? и как
починить?

Ну как вариант на одном из ПК на котором не работает.

открываете файл, заходить в редактор VBA (Alt+F11)
находите строку
Код
ChDir ThisWorkbook.Path & "\Банк изображений\" & Target.Name


и ставите на ней breakpoint, дальше в дебагере смотрите чему равно "ThisWorkbook.Path & "\Банк изображений\" & Target.Name"
Как сделать так, чтобы макрос работал на всех ПС?
 
Цитата
Марина пишет:
у одного пользователя после разархивации все работает, у

Разные ОС?

А посмотреть в Debug строку
Код
ChDir ThisWorkbook.Path & "\Банк изображений\" & Target.Name
?
Может пути в Dos формате прописываються, аля
Цитата
C:\Prograм~\Базаизо~\
?

это как раз может приводить к подобному поведению
Изменено: SkyShark - 06.02.2013 16:55:44
Перевернуть страницу
 
Цитата
andreika21 пишет:
в одном листе 1страница располагалась в книжном а 2страница альбомном формате

Само расположение нет, однако если необходимо только для печати, то можно что-нибудь придумать... например печать по кнопке, которая макросом задает диапозоны печати и печатает каждый диапазон по отдельности  О_о
Макрос переноса строк с постановкой "латки" на место удалённых строк.
 
Во вложении вариант с выбором листа мышкой (без ввода имени).

Выделенные строки и имя листа на котором выделили строки и нажали кнопку "перенести"  запоминаются в комментарии к книге.
Код
ThisWorkbook.BuiltinDocumentProperties("Comments")


Дальнейшая обработка срабатывает при активации другого листа
смотрите
Код
Workbook_SheetActivate
в "ЭтаКнига".

Перед запуском копирования строк появляется MsgBox с указанием на какие строки с кого листа и на какой лист будут скопированы.
Страницы: 1 2 3 След.
Наверх