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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 51 След.
Выполнение условия путем комбинации трех значений
 
Файл на форум не загрузился, увы. Загрузка остановилась на 90% и дальше не грузится.
Формулами можно решить так.

В столбец B.
Код
=ИНДЕКС($B$3:$P$3;ОСТАТ(СТРОКА()-СТРОКА($18:$18);B$10)+1)

В столбец C.
Код
=ИНДЕКС($B$4:$P$4;ОСТАТ(ЦЕЛОЕ((СТРОКА()-СТРОКА($18:$18))/B$10);C$10)+1)

В столбец D.
Код
=ИНДЕКС($B$5:$P$5;ОСТАТ(ЦЕЛОЕ((СТРОКА()-СТРОКА($18:$18))/C$10/B$10);D$10)+1)
Изменено: МатросНаЗебре - 14 Янв 2019 14:36:19
Пользовательская функция для перевода из различных систем счисления
 
MCH,
По 3 - при тестировании ошибок не нашёл. Не исключаю, что при определённых условиях неточность может возникать.
По 4 - решил обойтись без этого, для упрощения пользования функцией.
По 1 и 2 - согласен.

to all
У функции есть одна "недокументированная фича". Обработка ошибок неправильного ввода. Если во входной строке есть символы, которых не должно быть в используемой системе, например 2 в двоичной системе, то функция правильно отрабатывает эту нештатную ситуацию. Получилось случайно, решил не убирать, так more user friendly :)
Пользовательская функция для перевода из различных систем счисления
 
В прикреплённом примере находится пользовательская функция для перевода из(в) различных систем счисления.
Штатными функциями Excel достаточно просто переводить числа из десятичной, двоичной, восьмеричной и шестнадцатеричной систем.
Для перевода, например, из 17-ричной в 23-ричную можно воспользоваться этой функцией. (Не спрашивайте меня "зачем?" :)

Код может работать с "условно" бесконечными системами.
Сейчас в коде максимальная система с основанием 35.
Для увеличения основания, дополните массив c = Array("0", ... значениями требуемой системы.
Код
Function СистемаСчисления(Число As String, Optional СистемаИз As Byte = 10, Optional СистемаВ As Byte = 10)
    Dim d As Double
    Dim i As Integer
    Dim s As String
    Dim c As Variant
    Dim z As Long
    Dim k As Byte
    
    c = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    
    If Число = "0" Then
       СистемаСчисления = "0"
    Else
        'преобразование цифры в число
        d = 0
        For i = 1 To Len(Число)
            s = Mid(UCase(Число), i, 1)
            
            k = 0
            Do
                If s = c(k) Then
                    d = d + k * СистемаИз ^ (Len(Число) - i)
                    Exit Do
                End If
                k = k + 1
                If k > UBound(c) Then Exit Do
            Loop
        Next
        
        'преобразование числа в цифру
        s = ""
        For i = Val(Log(d) / Log(СистемаВ)) To 0 Step -1
            z = СистемаВ ^ i
            k = Val(d / z)
            
            s = s & c(k)
            d = d - k * z
        Next
        
        СистемаСчисления = s
    End If
End Function
Моделирование движения точки при постоянном g
 
Выкладываю пример с моделированием движения точки, находящейся между двух стенок:
при постоянном ускорении по вертикали,
при равномерной скорости по горизонтали.
Отображение движения по траектории, заданной табличными значениями, на примере посадки Бурана
 
В прикреплённом файле продемонстрировано отображения движения по траектории, заданной табличными значениями.
На примере посадки "Бурана".

PS. 15 ноября 1988 года состоялся первый полёт орбитального корабля Буран.
Перемещение по ячейкам выделенных разным цветом одной кнопкой
 
Цитата
bugser написал:  откорректированный пример
Не поверите. Но файл из #3 у меня срабатывает "как нужно".
Перемещение по ячейкам выделенных разным цветом одной кнопкой
 
Цитата
bugser написал: Не работает этот вариант у меня вообще.
Enter нажимали?
Перемещение по ячейкам выделенных разным цветом одной кнопкой
 
А так срабатывает по нажатию Enter.
Перемещение по ячейкам выделенных разным цветом одной кнопкой
 
Срабатывает не только по нажатию Enter.
Ексель 2003 как скрыть #Н/Д, Как скрыть #Н/Д по всему столбцу
 
=ЕСЛИ(ЕНД(выражение);"";выражение) - в формулу
или
=ЕНД(выражение) - в УФ
Изменено: МатросНаЗебре - 1 Ноя 2016 15:53:50
Случайный разброс данных
 
А так?
Случайный разброс данных
 
Вы правы.
Изменено: МатросНаЗебре - 1 Ноя 2016 15:32:33
Случайный разброс данных
 
Цитата
Diesel147 написал: С пятницы по воскресенье не может отдыхать более одной группы.
Цитата
Diesel147 написал: Между выходными не может быть более 5 дней.
Цитата
Diesel147 написал: Раскидать выходные между 5 и\или 6 группами
А Вы уверены, что одновременное выполнение всех условий возможно?
Прикладываю пример с частичным возложением на некоторые ограничения.
Выбор формулы для подсчета в зависимости от номера варианта задания
 
=СУММПРОИЗВ(--($D5:$AF5=СМЕЩ($D$1:$AF$1;(C5="В")*1;0)))
Выборка из строки с заданной таблицей соответствия и результатом через запятую
 
Цитата
werdew написал:
нигде не вижу результата
Покажется неожиданным, даже немного странным и слегка невероятным, но результат можно увидеть на листе "результат" :)
Выборка из строки с заданной таблицей соответствия и результатом через запятую
 
Код
    Dim iYvvod As Long
    Dim iYcorr As Long
    Dim shVvod As Worksheet
    Dim shCorr As Worksheet
    Dim shResu As Worksheet
    Dim arrResu() As Variant
    
    Set shVvod = Sheets("вводные данные")
    Set shCorr = Sheets("таблица соответствия")
    Set shResu = Sheets("результат")
        
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
     
    With shVvod.Columns(1)
        ReDim arrResu(.Cells(Rows.Count).End(xlUp).Row - 1, 1)
        
        For iYvvod = 1 To .Cells(Rows.Count).End(xlUp).Row
            arrResu(iYvvod - 1, 0) = .Cells(iYvvod).Value
            
            For iYcorr = 1 To shCorr.Cells(Rows.Count, 1).End(xlUp).Row
                If InStr(arrResu(iYvvod - 1, 0), shCorr.Cells(iYcorr, 1).Text) > 0 Then
                     arrResu(iYvvod - 1, 1) = arrResu(iYvvod - 1, 1) & IIf(arrResu(iYvvod - 1, 1) = "", "", ", ") & shCorr.Cells(iYcorr, 2).Text
                End If
            Next iYcorr
            
        Next iYvvod
    End With
     
    With shResu
        .Cells.Clear
        .Range(.Cells(1, 1), .Cells(UBound(arrResu, 1) + 1, 2)) = arrResu()
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

Изменено: МатросНаЗебре - 1 Ноя 2016 11:27:33
Синхронизация двух и более таблиц, Синхронизация двух и более таблиц
 
Вариант "исчезания" макросом.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Cells.Count > 1 Then Exit Sub
        If Intersect(.Cells, Range("G3:G120")) Is Nothing Then Exit Sub
        If .Value = "" Then Exit Sub
        
        Dim iY As Integer
        Dim i As Integer
               
        If WorksheetFunction.CountIfs(Columns(3), .Value) > 0 Then
            iY = WorksheetFunction.Match(.Value, Columns(3), 0)
            i = Cells(iY + 1, 3).Value
            Range(Cells(iY + 1, 2), Cells(iY + 1, 120)).Copy Cells(iY, 2)
            Cells(iY, 3).Value = i
            
        End If
    End With
End Sub

Синхронизация двух и более таблиц, Синхронизация двух и более таблиц
 
Вариант "исчезания" через условное форматирование.

ЗЫ В Вашем файле есть ссылка на файл "Учёт.xls". Тестить не удобно.
Как раскрыть выпадающий список клавишей с клавиатуры?
 
Alt + стрелка вниз
По завершении ввода данных макрос проверяет введенное число на кратность
 
Код
If (.Value / 6 - .Value \ 6) > 0.0000000001 Then
По завершении ввода данных макрос проверяет введенное число на кратность
 
Код
 With Target.Offset(, -1)  
Выборка первого и последнего значения из ряда ячеек, Выбрать первую и последнюю ячеку из ряда значений
 
Одной формулой :)

=ИНДЕКС(1:1;(СТОЛБЕЦ()-СТОЛБЕЦ($B:$B))*(СЧЁТЗ(1:1)-2)+2)
По завершении ввода данных макрос проверяет введенное число на кратность
 
А так ещё и выделяться будет не кратная ячейка.
Код
    With Target
        If .Value / 6 <> .Value \ 6 Then
            .Select '<------------------------------------------
            Call MsgBox("Не кратно 6.", vbCritical)
        End If
    End With
Выборка первого и последнего значения из ряда ячеек, Выбрать первую и последнюю ячеку из ряда значений
 
=СМЕЩ(A1;0;СЧЁТЗ(1:1)-1;1;1)
По завершении ввода данных макрос проверяет введенное число на кратность
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("H11:H1048576")) Is Nothing Then Exit Sub
    
    With Target
        If .Value / 6 <> .Value \ 6 Then
            Call MsgBox("Не кратно 6.", vbCritical)
        End If
    End With
    
End Sub

Найти в ячейкe слово и перетащить в начало
 
=ЕСЛИ(ЕОШ(НАЙТИ("купить";A2));A2;"Купить "&СТРОЧН(ЛЕВСИМВ(A2;1))&ПСТР(ПОДСТАВИТЬ(A2;" купить";"");2;ДЛСТР(A2)))
Нужно подтянуть значения начиная не с первой строки, а со строки которая является числом, Нужно подтянуть значения начиная не с первой строки, а со строки которая является числом
 
{=ИНДЕКС(Исходный!C:C;МАКС((Исходный!$A$2:$A$13=A2)*(Исходный!$C$2:$C$13<>"-")*СТРОКА(Исходный!$A$2:$A$13)))}
Открытие книги на нужной вкладке, Необходимо, что бы книга открывалась на последней вкладке во многопользовательском режиме
 
Попробуйте это:
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("Лист1").Activate
End Sub
Выделение жирным передать в такую же ячейку на другой лист
 
Код
Private Sub Worksheet_Activate()
    
    Dim c As Range
    
    With ActiveSheet
        .Cells.Clear
        
        For Each c In Sheets(1).UsedRange
            If c.Font.Bold Then
                .Range(c.Address).Value = 1
            Else
                .Range(c.Address).Value = 0
            End If
        Next
        
    End With
   
End Sub

Подсчет ячеек с шрифтом определённого цвета
 
Код
Option Explicit

Sub ПроверкаЖурналаЗаявок()
 
    Dim rngX As Range
    Dim c As Range
    Dim i As Integer
    Dim iM As Integer
    Dim iP As Integer
    Dim iMandP As Integer
    Dim colF As Double
    Dim j As Integer
    Dim bM As Boolean
    Dim bP As Boolean
     
Set rngX = Selection
Set c = rngX.Cells
 
    i = 0
    iM = 0
    iP = 0
    iMandP = 0
     
    For Each c In rngX
        If c.Value <> "" Then
            i = i + 1
            
            bM = False
            bP = False
            With c
                For j = 1 To Len(c.Text)
                   Select Case .Characters(Start:=j, Length:=1).Font.Color
                   Case 1842204, 1118481, 0
                    bM = True
                   Case 255, 204
                    bP = True
                   End Select
                Next j
            End With
            
            If bM Then iM = iM + 1
            If bP Then iP = iP + 1
            If bM And bP Then iMandP = iMandP + 1
        End If
    Next c
     
    Debug.Print "всего "; i
    Debug.Print "выход мех."; iM
    Debug.Print "простоев"; iP
     
    i = i - iM - iP + iMandP
     
    Debug.Print "аварийка"; i
 
End Sub

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 51 След.
Наверх