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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 15 След.
Распределение Брутто пропорционально Нетто, Код VBA
 
asesja, Доброго дня.
Если заполнить по всем правилам таблицу, т.е. чтобы не было пустых ячеек в данных. то можно формулой
=(C2/100)*(B2/СУММЕСЛИ(A:A;A2;B:B)*100)


P.S. протестил на 80тысяч строк, с учётом что в формуле используются неограниченные диапазоны А:А и В:В, всё рассчиталось за 54 секунды.
Изменено: Wild.Godlike - 24 Июл 2020 11:45:57
Заливка дат больше года
 
Razorte, И вам добрый день.

Вы бы для начала корректный пример составили.
- У вас в примере нет ни одной даты больше сегодня на один год
- У вас 10.06.2020 закрашена зелёным почему? да и вообще вся расцветка корявая, если сравнивать описание и пример.

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

имхо, переделывайте или описание или пример.
Выполнить код после обновления запросов PQ
 
файл то успевает открытся?)
Облегчение базы данных в Эксель, Как сделать чтобы БД в эксель работала шустрее
 
Можно ещё данный макрос попробовать в книге запустить.
Код
Sub ПочиститьФаилZVI()
' ZVI:2009-08-08 Active workbook excess formatting clearing
' Idea & original code of Just_Jon: http://www.mrexcel.com/forum/showthread.php?t=120831
' First attempt of modification: http://www.mrexcel.com/forum/showthread.php?t=339144
' Bugs tracking:
' 1. Range("A1") fixed to .Range("A1")
' 2. Exchanging:
'   .EntireRow.RowHeight to ws.StandardHeight
'   .EntireColumn.ColumnWidth to ws.StandardWidth
' Revised:2010-06-16
' 3.(ZVI:2010-06-16) Code for StandardHeight corrected. Comments shapes are skipped
'   https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=73659&MID=617994#message617994
' 4.(ZVI:2019-03-08) Deleting of entire columns & rows is used instead of Clear method
'   https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=114886&MID=954470#message954470
  Const Title = "MrExcelDiet: Just_Jon's code modified by ZVI"
  Const vbTab2 = vbTab & vbTab
  Dim Wb As Workbook, Ws As Worksheet, LastCell As Range, Shp As Shape, Chrt As Chart
  Dim Prot As Boolean, ProtWarning As Boolean, DoCharts As Boolean
  Dim LastRow&, LastCol&, ShpLastRow&, ShpLastCol&, i&, AC, x
  Dim SheetsTotal&, SheetsCleared&, ChartsCleared&, SheetsProtSkipped&
  Dim FileNameTmp$, BytesInFileOld&, BytesInFileNew&
  ' Choose the clearing mode
  Set Wb = ActiveWorkbook
  x = MsgBox("Excess formatting clearing of " & Wb.Name & vbCr & vbCr & _
             "Apply full clearing?" & vbCr & vbCr & _
             "Yes" & vbTab & "- Full mode, including chart's AutoScaleFont=False" & vbCr & _
             "No" & vbTab & "- Medium mode, without charts processing" & vbCr & _
             "Cancel" & vbTab & "- Stop clearing & Exit", _
             vbInformation + vbYesNoCancel, _
             Title)
  If x = vbCancel Then Exit Sub
  DoCharts = (x = vbYes)
  ' Freeze on
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    AC = .Calculation: .Calculation = xlCalculationManual
  End With
  ' Calculate the old file size
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
    Wb.SaveCopyAs FileNameTmp
    BytesInFileOld = .GetFile(FileNameTmp).Size
  End With
  ' Processing in each worksheet
  ProtWarning = True
  SheetsTotal = Wb.Sheets.Count
  For Each Ws In Wb.Worksheets
    With Ws
      ' Clear an error flag
      Err.Clear
      ' Inform on processing status
      Application.StatusBar = "MrExcelDiet: processing of sheet " & Ws.Name
      ' Check protection
      Prot = .ProtectContents
      ' Try to unprotect without password
      If Prot Then .Unprotect ""
      If (Err <> 0 Or .ProtectContents) And ProtWarning Then
        SheetsProtSkipped = SheetsProtSkipped + 1
        x = MsgBox(Ws.Name & " is protected and will be skipped" & vbCr & vbCr & _
                   "Skip warning on protected sheets?" & vbCr & vbCr & _
                   "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbCr & _
                   "No" & vbTab & "- Warning on each protected sheets" & vbCr & _
                   "Cancel" & vbTab & "- Stop clearing & Exit", _
                   vbExclamation + vbYesNoCancel, _
                   Title)
        ProtWarning = (x = vbNo)
        If x = vbCancel Then GoTo exit_
      Else
        ' Count processed worksheets
        SheetsCleared = SheetsCleared + 1
        ' Determine the last used cell with a formula or value or comment in Ws
        Set LastCell = GetLastCell(Ws)
        ' Determine the last column and last row
        If Not LastCell Is Nothing Then
          LastCol = LastCell.Column
          LastRow = LastCell.Row
        End If
        ' Determine if any merged cells are beyond the last row
        For Each x In Range(.Cells(LastRow, 1), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastRow = Max(LastRow, .Rows(.Rows.Count).Row)
            End With
          End If
        Next
        ' Determine if any merged cells are beyond the last column
        For Each x In Range(.Cells(1, LastCol), .Cells(LastRow, LastCol))
          If x.MergeCells Then
            With x.MergeArea
              LastCol = Max(LastCol, .Columns(.Columns.Count).Column)
            End With
          End If
        Next
        ' Determine if any shapes are beyond the last row and last column
        ShpLastCol = LastCol
        ShpLastRow = LastRow
        For Each Shp In .Shapes
          If Shp.Type <> msoComment Then  ' ZVI:2010-06-16
            ShpLastCol = Max(ShpLastCol, Shp.BottomRightCell.Column)
            ShpLastRow = Max(ShpLastRow, Shp.BottomRightCell.Row)
          End If
        Next
        ' Clear cells beyond the last column
        If LastCol < .Columns.Count Then
          With .Range(.Columns(LastCol + 1), .Columns(.Columns.Count))
            .EntireColumn.Delete ' rev4.
            If LastCol >= ShpLastCol Then
              ' Set StandardWidth to columns which are beyond the last col
              .EntireColumn.ColumnWidth = IIf(Ws.StandardWidth, Ws.StandardWidth, 8.43)  'Ws.StandardWidth
            End If
          End With
          If ShpLastCol < .Columns.Count Then
            ' Set StandardWidth to columns which are beyond the Shapes
            With .Range(.Columns(ShpLastCol + 1), .Columns(.Columns.Count))
              .EntireColumn.ColumnWidth = IIf(.StandardWidth, .StandardWidth, 8.43)  'Ws.StandardWidth
            End With
          End If
        End If
        ' Clear cells beyond the last row
        If LastRow < .Rows.Count Then
          With .Range(.Rows(LastRow + 1), .Rows(.Rows.Count))
            .EntireRow.Delete ' rev.4
            If LastRow >= ShpLastRow Then
              ' Set StandardWidth to rows which are beyond the last row
              .EntireRow.RowHeight = IIf(Ws.StandardHeight, Ws.StandardHeight, 12.75)
            End If
          End With
          If ShpLastRow < .Rows.Count Then
            ' Set StandardHeight to rows which are beyond the Shapes
            With .Range(.Rows(ShpLastRow + 1), .Rows(.Rows.Count))
              .EntireRow.RowHeight = IIf(.StandardHeight, .StandardHeight, 12.75)
            End With
          End If
        End If
        ' Reset last cell position of the sheet
        With .UsedRange: End With
        ' Protect the sheet if it was unprotected
        If Prot Then .Protect
      End If
      ' Apply setting to worksheet's charts: ChartArea.AutoScaleFont = False
      If DoCharts Then
        For i = 1 To .ChartObjects.Count
          Application.StatusBar = "MrExcelDiet: processing of chart " & .ChartObjects(i).Name
          .ChartObjects(i).Chart.ChartArea.AutoScaleFont = False
          ChartsCleared = ChartsCleared + 1
        Next
      End If
    End With
  Next
  ' Apply setting to workbook's charts: ChartArea.AutoScaleFont = False
  If DoCharts Then
    With Wb
      For i = 1 To .Charts.Count
        ' Clear an error flag
        Err.Clear
        ' Inform on processing status
        Application.StatusBar = "MrExcelDiet: processing of chart " & .Charts(i).Name
        ' Check chart sheet protection
        Prot = .Charts(i).ProtectContents
        ' Try to unprotect chart sheet without password
        If Prot Then .Charts(i).Unprotect ""
        If (Err <> 0 Or .Charts(i).ProtectContents) And ProtWarning Then
          SheetsProtSkipped = SheetsProtSkipped + 1
          x = MsgBox(Ws.Name & " is protected and will be skipped" & vbCr & vbCr & _
                     "Skip warning on protected sheets?" & vbCr & vbCr & _
                     "Yes" & vbTab & "- Skip warning, clear sheets silently" & vbCr & _
                     "No" & vbTab & "- Warning on each protected sheets" & vbCr & _
                     "Cancel" & vbTab & "- Stop clearing & Exit", _
                     vbExclamation + vbYesNoCancel, _
                     Title)
          ProtWarning = (x = vbNo)
          If x = vbCancel Then GoTo exit_
        Else
          ' Set AutoScaleFont = False for chart sheet
          .Charts(i).ChartArea.AutoScaleFont = False
          SheetsCleared = SheetsCleared + 1
          ChartsCleared = ChartsCleared + 1
          ' Protect the chart sheet if it was unprotected
          If Prot Then .Charts(i).Protect
        End If
      Next
    End With
  End If
exit_:
  ' Calculate the new file size
  Wb.SaveCopyAs FileNameTmp
  BytesInFileNew = CreateObject("Scripting.FileSystemObject").GetFile(FileNameTmp).Size
  Kill FileNameTmp
  ' Freeze off
  With Application
    .Calculation = AC
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  ' Report on results
  Application.StatusBar = False
  x = MsgBox("Statistics of excess formatting clearing" & vbLf & vbLf & _
             "Workbook:" & vbTab & ActiveWorkbook.Name & "'" & vbLf & _
             "Sheets total:" & vbTab2 & SheetsTotal & vbLf & _
             "Sheets cleared:" & vbTab2 & SheetsCleared & vbLf & _
             "Protected sheets skipped: " & vbTab & SheetsProtSkipped & vbLf & _
             "Other sheets skipped:" & vbTab & SheetsTotal - SheetsCleared - SheetsProtSkipped & vbLf & _
             "Charts cleared:" & vbTab2 & ChartsCleared & vbLf & _
             "File size old:" & vbTab & Format(BytesInFileOld, "# ### ##0") & " Bytes" & vbLf & _
             "File size new:" & vbTab & Format(BytesInFileNew, "# ### ##0") & " Bytes" & vbLf & _
             vbLf & _
             "Save the cleared workbook to keep the changes?" & vbLf & _
             "Yes" & vbTab & "- Save & Exit" & vbLf & _
             "No" & vbTab & "- Exit without saving, cleared", _
             vbInformation + vbYesNo + IIf(BytesInFileNew < BytesInFileOld, vbDefaultButton1, vbDefaultButton2), _
             Title)
  If x = vbYes Then Wb.Save
End Sub
  
' ZVI:2009-02-02 Get last cell within values/formulas/comments of sheet Sh
' Auto-filtered & hidden rows/columns are also calculated without ShowAllData
' ActiveSheet is used if optional Sh is missing
' If VisibleOnly=True then only visible cells are searched
Function GetLastCell(Optional Sh As Worksheet, Optional VisibleOnly As Boolean) As Range
  Dim SpecCells(), rng As Range, r&, c&, x, a
  SpecCells = Array(xlCellTypeConstants, xlCellTypeFormulas, xlCellTypeComments)
  On Error Resume Next
  If Sh Is Nothing Then Set Sh = ActiveSheet
  Set rng = Sh.UsedRange
  If VisibleOnly Then Set rng = rng.SpecialCells(xlCellTypeVisible)
  For Each x In SpecCells
    For Each a In rng.SpecialCells(x).Areas
      With a.Cells(a.Rows.Count, a.Columns.Count)
        c = Max(c, .Column)
        r = Max(r, .Row)
      End With
    Next
  Next
  If r * c <> 0 Then Set GetLastCell = Sh.Cells(r, c)
End Function
  
' Aux function: max value of arguments
Private Function Max(ParamArray Values())
  Dim x
  For Each x In Values
    If x > Max Then Max = x
  Next
End Function

Как корректно посчитать разницу во времени
 
Яна Круглова, Здравствуйте.

Поставте формат ячейки как на скриншоте у всего столбца "DN"
Также обратите внимание на ячейку "ВС8" у вас в ней "13.12.1904  18:09:00" из за чего итоги по строке неверные
Преобразовать список номеров телефонов в вид 79999999999
 
burov_oleg,
Замените в коде
Код
.Value = "7" + Right(.Text, 10)

На
Код
.Value = "нужное вам" + Right(.Text, 10)
Посчитать разрешенный лимит траты на день, с учётом предыдущих трат.
 
Дмитрий Иванов, Доброго дня, смотрите вложение. Заполнять желтые ячейки. ну там поиграйтесь или переделайте под себя.
Как уже написал вам выше Максим В., ознакомтесь с правилами форума.

Название темы: Посчитать разрешенный лимит траты на день, с учётом предыдущих трат.
Выполнить код после обновления запросов PQ
 
adamm, Доброго дня, не особо шарю но мб поможет.

Код
Call Обновление
Application.Wait Time:=Now + TimeSerial(0, 0, 10) 'задержит выполнение Вашего макроса на 10 секунд.
If Format(Now, "hh:mm") > "21:00" Then Рассылка


Возможно надо воткнуть не в этом месте, не особо вникал в код :D
Изменено: Wild.Godlike - 24 Июн 2020 10:05:52
Сохранение печатающихся листов в папку при помощи макроса, Как добавить еще строчки кода для того что бы макрос не только выполнянл печать паспортом поочередную, но и еще сохранял в отдельную папку в pdf
 
Anri_amar, Доброго дня, я бы вам рекомендовал, показать или пример(файл с обезличеными данными) или привести код полностью а не огрызок.

P.S. код следует оформлять красивенько, найдтите кнопочку <...> на панели. бонус
Округление расчёта формулы до двух знаков после запятой и сравнение с эталоном
 
Vladimir Chebykin, Доброго дня, шикарно *_*. спасибо большое.
БМВ,  :cry: опять переводить :D Перевёл, шикарнотаа )

Спасибо всем большое, забрал всё что накидали. буду играться. :oops:
Округление расчёта формулы до двух знаков после запятой и сравнение с эталоном
 
БМВ, сначало думал округлять/отрезать, после варианта Mershik, оказалось что вообще другое :С хотя пока сколько игрался с файлом не думал что так получится.

Предлагаю поменять зазвание темы на:
Цитата
Wild.Godlike написал:
Если результат формулы +-0,01 от эталона, то = эталон, иначе результат формулы.


для сравнение это мне как раз идеально подходит, но по мимо сравнения нужно ещё и результат чтобы был видем так же.
Цитата
БМВ написал:
=ABS(F2-G2)<0,01
Изменено: Wild.Godlike - 17 Июн 2020 16:02:10
Округление расчёта формулы до двух знаков после запятой и сравнение с эталоном
 
sokol92,Приветствую, была бы возможность целый холдинг с места не сдвинешь (

Mershik, Да по примеру помогло, за то другие строчки перестали работать :(

P.S. пока не попробовал вашу формулу не думал что так получится.

А универсально сделать не вариант?
по типу
Если результат формулы +-0,01 то = эталон, иначе результат формулы. (наверное для такого отдельную тему тогда создать да? или название поменять?)
Округление расчёта формулы до двух знаков после запятой и сравнение с эталоном
 
Доброго дня. нужна именно формула.

В столбце F имеется эталонная сумма (является значением округлено до 2 знаков после запятой, вообще это выгрузка из БД)
В столбце G эта же сумма расчитаная формулой

Собственно проблема:
сумма эталон: 1603,39
Сумма рассчитанная формулой: 1603,39510451613
Я ставлю формат ячейки 2 знака после запятой и результат 1603,40
Я использую ОКРУГЛ результат 1603,40

Мне надо чтобы в этой же ячейки получился результат 1603,39 и при сравнении была истина.
Как округлить до двух знаков чтобы при этом 39 не превратилось в 40
P.S. покурил вот это IEEE 754, но видать поставщик был плохой как то победить не понял :С
Изменено: Wild.Godlike - 17 Июн 2020 14:46:39
Вес вложения в основной ветке и в ветке работа
 
Николай Павлов, Всё верно, в zip, работает корректно :) Благодарствую.
Вес вложения в основной ветке и в ветке работа
 
Николай Павлов, Доброго дня :) дак xml вроде вообще 4кб весит ) или это немного корявое отображение и ругается именно на xml?
Вес вложения в основной ветке и в ветке работа
 
Ну собственно сабж в теме

В основной ветке 300кб ограничение
в ветке работа 100кб ограничение

Дискриминация,сексизм,расизм :D

почему так?)
Подстановка фраз к списку других фраз
 
Доброго дня.
Вариант PQ во вложении.
На листе "Список запросов" можете в таблицы добавлять сколько угодно фраз.
На листе "Лист2" по таблице ПКМ обновить.

На текущий момент 2200 вариантов

Ох уж эти начинающие SEOшники, которые не могут в семантику и кластеризацию. :D
Поиск и расшифровка маркировки товара в тексте ячейки, выявление маркировки в тексте ячейки
 
День добрый.
Что-то мне подсказывает, что с такими задачами вам в платную ветку.
Суммирование из таблицы по 4 критериям
 
Александр L, Доброго дня

Сделал Как понял. вставляйте в D10 и протяните по маленькой таблице.
=СУММПРОИЗВ(($B$22:$B$221=$A10)*($C$22:$C$221=$B10)*($D$22:$D$221=$C10)*($F$21:$L$21=D$9)*$F$22:$L$221)
Определение оптимального способа найти совпадения "искомого значения" со столбцами поиска
 
Назар Пыхтин, Доброго дня, посмотрите вот тут Fuzzy loockup

P.S. подход к описанию конечно интересный, но нефига не понятный :D
Обращение "на ты" или "на вы"
 
Доброго дня :) Вставлю свои 5 копеек

Имхо, у нас в России, такой менталитет, и манера письменной/разговорной речи, т.е. разделение на ТЫ/ВЫ, и плевать что в остальном мире такого нет.

Хотя
Цитата
БМВ написал:
Ну нет у иносранцев отчеств и разницы ты/вы U

У них есть всякие Мисс, мисис, мистер, господин/повелитель, и т.д. (мб не прав).

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

А ты не мог бы помочь мне с вот этим? :)

Ещё и добавив какой нибудь смайлик в конце, или добрая мордашка в реале. то чтож тут плохого.

В добавок к этому, я вот не представляю сижу я такой в компании, пиво пью, приходят друзья друзей, представляются, условно "Иван", чтож мне его на ВЫ называть?)

ПО итогу:
Всё от ситуации и контекста разговора, очень тонкая грань между всем этим ТЫ/ВЫ. (Не беру в расчёт общение на работе, там порой всё это прописано на уровне корпоративной этики и т.д.)
Изменено: Wild.Godlike - 4 Июн 2020 09:05:45
Не проигрывается звук из файлов *.mp4
 
Цитата
Красноглазый Пиркаф написал: нет, нужно именно mp4, потому что их - несколько тысяч.
зачем слушать несколько тысяч MP4 (это ещё сколько же оно весит), когда можно просто сконвертить всё в МР3.....
офтоп
Создание гипер ссылок между найдеными данными VBA only.
 
:) Беседуем
Создание гипер ссылок между найдеными данными VBA only.
 
:) Доброго дня, товарищи.
Собственно нужен макрос.

Суть мы указываем 2 диапазона которые необходимо сравнить между собой и между идентичными данными создать гиперссылки друг на друга.
Пропуская пустые ячейки.
Может быть выделен как столбец/так отдельный диапазон.
Диапазоны не всегда равны друг другу (т.е. в 1 может быть 1 ячейка, а 2 может быть 500, и на оборот)
Может быть так что 1 значение ведёт на 10, т.е. гиперсылка из А1 может ссылаться на B1:B10
Все диапазоны предварительно всегда будут отсортированы по возрастанию. (я так понимаю это в любом случае необходимо т.к. если будет ситуация как я написал на строчке выше, на "разорванный" диапазон гиперссылку сформировать нельзя(да и это глупо)).

Грубо говоря(объяснение школьника) ВПР по 1 столбцу только,вместо результата, создание гиперссылки на результат.

При его запуске, открывается Юзер форма которая содержит 4 элемента
1) поле с указанием одного диапазона
2) поле с указанием второго диапазона
3) окей
4) закрыть(отмена)


Хм... ну бюджет 300? 400? (Пишите в личку на форуме, цена/где удобнее общаться).

P.S. на первом листе сделал пример 1 ячейку которая ведёт на другой лист и на оборот.
P.S.S. Рабочий день всё такое, так что не прям сразу же отвечаю :)
Изменено: Wild.Godlike - 25 Май 2020 09:29:00
Выбрать даты без выходных и отпусков
 
bobr2610, Суть того что вам написал Mershik, Что из вашего описания и примера нефига не понятно
ошибка в PQ: Expression.Error
 
Darina15, И вам доброго дня. ТЫЦ

Скорее всего в каком то из файлов, у вас другая таблица (не как в эталоне или её просто нет)
Изменено: Wild.Godlike - 21 Май 2020 10:34:18
Накопление текстовых значений ячеек, Артикул с полной размерной линейкой в каждой строке
 
ela98, Добрый день.

ФОРМУЛА : =A6&","&СцепитьЕсли($A$3:$A$14;A6;$B$3:$B$14;",";0)

UDF сцепитьесли
Изменено: Rustam Kabirov - 20 Май 2020 12:39:56
График изготовления деталей по сменам
 
777555, Существуют правила о файле примере ) или ответ вы тоже картинкой получить хотите?

P.S. и ник и т.д. модераторы придут будут делать а-та-та
Изменено: Rustam Kabirov - 20 Май 2020 11:54:39
Подсчет светлого времени суток в зависимости от режима дня.
 
Цитата
aequit написал:
я пробовал для Воркуты сделать
:D А я вчера и так и сяк тыкал) ЯСНА ПОНЯТНА. поменяю место жительства мб, вспомню про ваш файлик ) сохранил в копилку.
Как создать письмо "Иванов И.И. от имени Пупкина П.П." VBA
 
Дмитрий(The_Prist) Щербаков, Спасибо большое, протестировал. всё работает.

БМВ, У нас админы выдают на учётку права пользователю, что он может отправлять письма от имени компании (чтобы не палить свою рабочую почту)
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 15 След.
Наверх