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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 214 След.
Открытие ссылки из одного столбца по гипперссылке в другом
 
На компьютере работает.
Погуглите, как открыть браузер в Excel под Apple на телефоне. Замените эту строку:
Код
CreateObject("WScript.Shell").Run Target.Cells(1, 2).Value
возврат названия столбца, возврат названия столбца в отдельный столбец,если в нем есть сумма
 
Цитата
написал:
ИНДЕКС() зачем? ПОИСКПОЗ() достаточно.
В данной ситуации название совпадает с индексом, но ТС просил вернуть именно название столбца. Может он его собирается поменять.
возврат названия столбца, возврат названия столбца в отдельный столбец,если в нем есть сумма
 
Добавьте девяток в аргументе.
Открытие ссылки из одного столбца по гипперссылке в другом
 
В модуль листа.
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    CreateObject("WScript.Shell").Run Target.Cells(1, 2).Value
End Sub
Лучше, конечно, добавить ограничение по диапазону.
возврат названия столбца, возврат названия столбца в отдельный столбец,если в нем есть сумма
 
Вы попробовали, и вам вернуло другой вариант?
возврат названия столбца, возврат названия столбца в отдельный столбец,если в нем есть сумма
 
Код
=ИНДЕКС($I$2:$M$2;ПОИСКПОЗ(999;I3:M3;1))
Поиск приблизительного наибольшего или наименьшего значения по диапазону чисел, Поиск приблизительного наибольшего или наименьшего значения по диапазону чисел
 
Дополнил для равных значений.
Код
=ИНДЕКС($E$1:$M$6;ЕСЛИ(B2>МАКС(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));ПОИСКПОЗ(МАКС(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0));0);ЕСЛИ(B2<МИН(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));2;ЕСЛИ(B2=ВПР(B2;ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0));1;1);ПОИСКПОЗ(B2;ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0));1);ПОИСКПОЗ(B2;ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)))+1)));ПОИСКПОЗ(A2;$E$1:$M$1;0))
Поиск приблизительного наибольшего или наименьшего значения по диапазону чисел, Поиск приблизительного наибольшего или наименьшего значения по диапазону чисел
 
Цитата
написал:
Можно конечно попробовать прописать кучу матрешек с "если", но это решение не кажется оптимальным.
Действительно, кучу матрешек с "если" не кажется оптимальной. Попробуйте такой вариант:
Код
=ИНДЕКС($E$1:$M$6;ЕСЛИ(B2>МАКС(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));ПОИСКПОЗ(МАКС(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0));0);ЕСЛИ(B2<МИН(ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)));2;ПОИСКПОЗ(B2;ИНДЕКС($E$1:$M$6;;ПОИСКПОЗ(A2;$E$1:$M$1;0)))+1));ПОИСКПОЗ(A2;$E$1:$M$1;0))
Отчетный документ по кассе с группировкой по конкректным товарам, месяцам и ценой за ед.продукции, Есть документ по кассе (продажи за несколько месяцев некоторых продуктов). Из продуктов нужно выбрать продажи по списку из трех продуктов. Один выходной документ д.б.
 
Выделите ячейки, запустите макрос.
Код
Option Explicit

Sub myPrint()
    CloseEmptyWb

    Dim rr As Range
    On Error Resume Next
    Set rr = Intersect(Selection, ActiveSheet.UsedRange)
    On Error GoTo 0
    Dim arr As Variant
    arr = rr.Columns(1).Resize(, 6).Value
    ClearArray arr
    
    Dim yb As Long
    Dim brr As Variant
    ReDim brr(1 To UBound(arr, 1) + 1, 1 To UBound(arr, 1) + 1)
    
    Dim dicX As Object: Set dicX = CreateObject("Scripting.Dictionary")
    Dim dicY As Object: Set dicY = CreateObject("Scripting.Dictionary")
    
    Dim crr As Variant
    ReDim crr(0 To 1)
    Dim yc As Long
    For yc = LBound(crr) To UBound(crr)
        crr(yc) = brr
        Set dicY.Item(yc) = CreateObject("Scripting.Dictionary")
    Next
    
    Dim sd As String
    Dim dt As Date
    Dim xa As Long
    Dim ya As Long
    Dim yi As Long
    For ya = 1 To UBound(arr, 1)
        If IsNumeric(arr(ya, 5)) Then
            If IsNumeric(arr(ya, 6)) Then
                If arr(ya, 5) < 60 Then
                    yc = 0
                Else
                    yc = 1
                End If
                
                sd = Left(arr(ya, 1), Len("01.10.2021"))
                If IsDate(sd) Then
                    dt = DateSerial(Year(CDate(sd)), Month(CDate(sd)), 1)
                    If Not dicX.Exists(dt) Then
                        xa = dicX.Count + 1
                        dicX.Item(dt) = xa
                        
                        For yi = LBound(crr) To UBound(crr)
                            crr(yi)(1, xa + 1) = dt
                        Next
                    Else
                        xa = dicX.Item(dt)
                    End If
                    
                    If Not dicY.Item(yc).Exists(arr(ya, 4)) Then
                        yb = dicY.Item(yc).Count + 1
                        dicY.Item(yc).Item(arr(ya, 4)) = yb
                        crr(yc)(yb + 1, 1) = arr(ya, 4)
                    Else
                        yb = dicY.Item(yc).Item(arr(ya, 4))
                    End If
                    crr(yc)(yb + 1, xa + 1) = crr(yc)(yb + 1, xa + 1) + arr(ya, 5) * arr(ya, 6)
                End If
            End If
        End If
    Next
    For yi = LBound(crr) To UBound(crr)
        crr(yi) = ResizeArray(crr(yi))
    Next
    
    PrintArray crr
End Sub

Private Function ResizeArray(arr As Variant) As Variant
    Dim ya As Long
    Dim xa As Long
    For ya = UBound(arr, 1) To 1 Step -1
        If Not IsEmpty(arr(ya, 1)) Then Exit For
    Next
    
    For xa = UBound(arr, 2) To 1 Step -1
        If Not IsEmpty(arr(1, xa)) Then Exit For
    Next
    
    Dim brr As Variant
    ReDim brr(1 To ya, 1 To xa)
    For ya = 1 To UBound(brr, 1)
        For xa = 1 To UBound(brr, 2)
            brr(ya, xa) = arr(ya, xa)
        Next
    Next
    ResizeArray = brr
End Function

Private Sub PrintArray(crr As Variant)
    Workbooks.Add (1)
    
    Dim rOut As Range
    Set rOut = Cells(1, 1)
    
    Dim yc As Long
    For yc = LBound(crr) To UBound(crr)
        With rOut.Resize(UBound(crr(yc), 1), UBound(crr(yc), 2))
            .Value = crr(yc)
            .Rows(1).NumberFormat = "mmmm yy"
            .EntireColumn.AutoFit
            Set rOut = .Cells(1 + .Rows.Count + 1, 1)
        End With
    Next
End Sub

Private Sub ClearArray(arr As Variant)
    Dim ya As Long
    Dim xa As Long
    For ya = LBound(arr, 1) To UBound(arr, 1)
        For xa = LBound(arr, 2) To UBound(arr, 2)
            If IsError(arr(ya, xa)) Then
                arr(ya, xa) = Empty
            End If
        Next
    Next
End Sub

Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub

Автоматическое обновление сводной таблицы из постоянно пополняемой таблицы, Надо чтобы итоговая таблица содержала свод позиций с другого листа с добавляемыми строками
 
Если файл выглядит, как вы описали в сообщении #1, то можно применить такие формулы:
Код
'один!'G2(и протянуть вниз)    =СУММЕСЛИМН(C:C;B:B;B:B;F:F;"покупка")-СУММЕСЛИМН(C:C;B:B;B:B;F:F;"продажа")
'один!'H2(и протянуть вниз)    =H1+(G2>0)*(СЧЁТЕСЛИМН(B$1:B1;B2)=0)]
'сводный!'A1:A3    =СМЕЩ(один!B$1;ПОИСКПОЗ(СТРОКА();один!$H:$H;0)-1;0)
'сводный!'B1:B3    =ВПР(A:A;один!B:G;6;0)
Связанные выпадающие списки
 
Пишу в личку.
Заказ свободен.
Изменено: МатросНаЗебре - 29.03.2024 15:19:50
Фильтр с двумя критериями, Нужна помощь по фильтру
 
Вариант с дополнительным столбцом. Вставьте в строку 2 и протяните вниз. Фильтруйте по 2.
Код
=ЕСЛИ(A2="InterestRate";2;ЕСЛИ(И(ЛЕВСИМВ(A2;3)="Кр-";F3=1);2;ЕСЛИ(ЛЕВСИМВ(A3;3)="Кр-";0;ЕСЛИ(A3="InterestRate";1;F3))))
Фильтр с двумя критериями, Нужна помощь по фильтру
 
Фильтр-Текстовые фильтры-Содержит...-Содержит [InterestRate ]-ИЛИ-Содержит [Кр-]
Объединение листов
 
ДВССЫЛ()
Из столбца с названием предприятия и несколькими его адресами извлечь с повтором название предприятия., Помощь при обработке данных Excel/Данные таблицы Excel
 
Выделите ячейки, запустите макрос.
Код
Sub myFill()
    ActiveSheet.Copy
    
    Dim rr As Range
    Set rr = Intersect(Selection, ActiveSheet.UsedRange)
    
    Selection.EntireColumn.Columns(1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Dim rb As Range
    Dim cl As Range
    For Each cl In rr.Columns(1).Cells
        Debug.Print cl.Value
        If cl.Font.Bold Then
            Set rb = cl
        End If
        If Not rb Is Nothing Then
            rb.Copy cl.Offset(, -1)
        End If
    Next
    rb.Offset(, -1).EntireColumn.AutoFit
End Sub
Максимальное кол-во пустых ячеек между непустыми ячейками, Максимальное кол-во пустых ячеек между непустыми ячейками
 
Вариант через пользовательскую функцию.
Код
=МАКСНЕПУТЫХ(B2:P2)
Код
Function МАКСНЕПУТЫХ(Диапазон As Range) As Long
    Dim arr As Variant
    arr = Диапазон
    
    Dim res As Long
    Dim nn As Long
    Dim ya As Long
    Dim xa As Long
    Dim x1 As Long
    Dim x2 As Long
    For ya = 1 To UBound(arr, 1)
        
        For x1 = 1 To UBound(arr, 2)
            If Not IsEmpty(arr(ya, x1)) Then Exit For
        Next
        For x2 = UBound(arr, 2) To 1 Step -1
            If Not IsEmpty(arr(ya, x2)) Then Exit For
        Next
        
        nn = 0
        For xa = x1 To x2
            If IsEmpty(arr(ya, xa)) Then
                nn = nn + 1
                If res < nn Then res = nn
            Else
                nn = 0
            End If
        Next
    Next
    МАКСНЕПУТЫХ = res
End Function
Копирование данных из одного Эксель в другой по Ключевому слову
 
Код
=ЕСЛИОШИБКА(ЕСЛИ(ВПР(A:A;'[ФАЙЛ НОМЕР 2.xlsx]Лист1'!$A:$D;3;0)="";ВПР(A:A;'[ФАЙЛ НОМЕР 2.xlsx]Лист1'!$A:$D;4;0);ВПР(A:A;'[ФАЙЛ НОМЕР 2.xlsx]Лист1'!$A:$D;3;0));"")
Формула массива, которая подтягивает к числам данные из соседней таблицы, которые соответствуют по условию
 
Код
=ВПР(;;;1)
Можно обойтись ВПР с параметром 1.
Преобразовать дату в месяц (дата выгружается не корректно), дата выгружается не корректно
 
Код
=ДАТАЗНАЧ(ПОДСТАВИТЬ(B4;СИМВОЛ(10);""))
Сумма количества дней из диапазона согласно заданным условиям
 
Код
=МИН($E6;F$2)-МАКС($D6;F$1)
Так?
Функция РАЗНДАТ некорректно определяет количество месяцев
 
07.03.2024
Сложносочиненная ИНДЕКС-ПОИСКПОЗ, Не удаётся правильно составить формулу
 
Код
=ЕСЛИОШИБКА(ИНДЕКС(Таблица2[Контракт];1/(1/МАКС((ЕСЛИОШИБКА(НАЙТИ($A2;Таблица2[Адрес]);0)>0)*(ЕСЛИОШИБКА(НАЙТИ(B$1;Таблица2[Предмет]);0)>0)*(ДЛСТР(Таблица2[Р/н])=7)*СТРОКА(Таблица2[Адрес])))-1);"")
Формула массива.
Анализ и представление
 
Он нас обвиняет в отсутствии дружелюбности!
Быть такого не может! Да что этот обрыган себе позволяет!!!
:D  
Переход к следующему номеру Акта с помощью Макроса
 
Код
Sub myIncrement()
    Dim yy As Long
    yy = GetY(Range("AB1").Value)
    If yy = 0 Then Exit Sub
    Range("AB1").Value = GetKeyRange().Cells(yy + 1, 1).Value
End Sub

Sub myDecrement()
    Dim yy As Long
    yy = GetY(Range("AB1").Value)
    If yy < 2 Then Exit Sub
    Range("AB1").Value = GetKeyRange().Cells(yy - 1, 1).Value
End Sub

Private Function GetY(vValue As Variant)
    On Error Resume Next
    GetY = WorksheetFunction.Match(vValue, GetKeyRange(), 0)
    On Error GoTo 0
End Function

Private Function GetKeyRange() As Range
    Set GetKeyRange = Sheets("Данные АОСР").ListObjects("Данные_для_АОСР").ListColumns("KEY").DataBodyRange
End Function
Анализ и представление
 
Цитата
написал:
Это вариант, так называемого, репроцитного обмена, широко распространенного на ранних стадиях эволюции человеческих сообществ. Почему не вернуться к нему - т.е. Безденежно. Хотя бы в некоторых нетривиальных ситуациях.
Да, были времена! Здорово, наверное, было. Взял поменялся с кем-то репроцитно, и ходишь довольный. Жаль, конечно, что никак не вернуться к "репроцитному обмену"... Вот вы удивитесь, заглянув в ветку Вопросы по Microsoft Excel (planetaexcel.ru). В простонародье её называют бесплатной, но вы можете называть "репроцитной".
Поиск первой пустой ячейки в столбце
 
Код
With Cells(1, "N")
    iLastRow = IIf(IsEmpty(.Value), 1, .End(xlDown).Row + 1)
End With
Анализ и представление
 
Опять же с учётом сказанного выше
Цитата
написал:
компетенции ТСа нам неизвестны
ценность "35-40 страниц А4" не велика не определена.
Вопрос по работе с курсами валют, Подскажите пожалуйста нужную формулу
 
Код
=ВПР(A:A;C:D;2;0)
Выбор листа в формуле по меняющемуся названию в ячейке, Выбор листа в формуле по меняющемуся названию в ячейке
 
Код
=ДВССЫЛ("'"&A1&"'!C1")
Выделение информации из ячейки при помощи макроса, Разработать макрос для автоматического вывода в соседние ячейки отдельных позиций.
 
Вариант через пользовательскую функцию.
Это в стандартный модуль. Alt+F11
Код
Option Explicit

Public Function РАЗДЕЛИТЬ(Строка As String, Индекс_начало As Long, Индекс_конец As Long) As Variant
    Const DLM = "-"
    If InStr(Строка, DLM) = 0 Then
        РАЗДЕЛИТЬ = Строка
    Else
        Dim arr As Variant
        arr = Split(Строка, DLM)
        
        ReverseIndex Индекс_начало, UBound(arr)
        ReverseIndex Индекс_конец, UBound(arr)
        
        Dim brr As Variant
        ReDim brr(Индекс_начало To Индекс_конец)
        
        Dim yb As Long
        For yb = LBound(brr) To UBound(brr)
            brr(yb) = arr(yb)
        Next
        
        РАЗДЕЛИТЬ = Join(brr, DLM)
    End If
End Function

Private Sub ReverseIndex(ind As Long, iUbo As Long)
    If ind < 0 Then
        ind = iUbo + ind + 1
    Else
        ind = ind - 1
    End If
End Sub

Это на лист и протянуть:
Код
G3    =РАЗДЕЛИТЬ($A3;2;2)
H3    =РАЗДЕЛИТЬ($A3;3;3)
I3    =РАЗДЕЛИТЬ($A3;4;-3)
J3    =РАЗДЕЛИТЬ($A3;-2;-2)
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 214 След.
Наверх