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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 152 След.
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Заточено под макрос. UDF в том варианте не работает. Запустите макрос test. Если нужно автоматическое обновление, макрос можно повесить на событие.
Выбор и подсчет количества повторяющихся значений в соседний столбец (новый лист)
 
Код
С4         =ЕСЛИОШИБКА(ИНДЕКС($A$1:$A$15;ПОИСКПОЗ(СТРОКА(C1);D:D;0));"")
D4         =D3+(СЧЁТЕСЛИМН($A$1:A4;A4)=1)
и протянуть вниз.
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Код
Sub test()
    Dim cl As Range
    For Each cl In Range("F14:F24")
        cl.Cells(1, 2).Value = GetCellFormula(cl)
    Next
End Sub
Function GetCellFormula(cl As Range) As String
    Dim ss As String
    ss = cl.FormulaLocal
    ss = Replace(ss, "$", "")
    
    Dim dd As Double
    Dim rDP As Range
    On Error Resume Next
    Set rDP = cl.DirectPrecedents
    On Error GoTo 0
    If Not rDP Is Nothing Then
        Dim dp As Range
        For Each dp In rDP
            dd = dp.Value
            ss = Replace(ss, dp.Address(0, 0, xlA1), dd)
        Next
    End If
    GetCellFormula = "'" & ss
End Function
Как подставить дробное число в формулу?, VBA
 
Код
Cells(i, FactValue).Formula = "=(" & Replace(k, ",", ".") & "/1.2)/курс"
Свод данных столбца по совпадающему слову, Свод данных столбца по совпадающему слову
 
Код
Sub test()
    mySumm Range("B2:B30"), Range("C2:C30"), Range("D2"), "Коврик"
End Sub

Sub mySumm(rNames As Range, rValue As Range, rTarget As Range, lookString As String)
    Dim aNam As Variant
    Dim aVal As Variant
    aNam = rNames
    aVal = rValue.Cells(1, 1).Resize(UBound(aNam, 1))
    
    Dim dd As Double
    Dim yy As Long
    For yy = 1 To UBound(aNam)
        If aNam(yy, 1) Like "*" & lookString & "*" Then
            dd = dd + aVal(yy, 1)
        End If
    Next
    
    rTarget.Value = dd
End Sub
Цитата
написал:
без списка коротких наименований, либо списка исключений будет проблема
Будут решаться по мере поступления )
Свод данных столбца по совпадающему слову, Свод данных столбца по совпадающему слову
 
Цитата
написал:
собрать с помощью формулы по совпадающему слову Коврик
Код
=СУММЕСЛИМН(C2:C30;B2:B30;"=Коврик*")

Цитата
написал:
в реальности в моей таблице более 1000000 строк
Лучше макрос.
Нужно расширить возможности макроса, Не очень удобный существующий макрос для печати
 
С учётом #5 )
Код
Sub четырнадцать3()
    With Workbooks("исполнительная.xlsm")
        Dim vv As Variant
        Dim q, w As Integer
        Dim arr As Variant
        ReDim arr(1 To 1, 1 To 9)
        arr(1, 4) = "Сварка"
        arr(1, 6) = "200"
        arr(1, 7) = "0.04"
        arr(1, 9) = "годно"
          
        Dim drr As Variant
          
        w = 0
        For Each vv In Array(5, 6, 7)
            
            With .Sheets("Даные")
                q = .Cells(.Rows.Count, vv).End(xlUp).Row
                drr = .Range(.Cells(1, vv), .Cells(q, vv))
            End With
            If UBound(drr, 1) > 6 Then
                If drr(6, 1) <> " " Then
                    q = 1
                    Do While Not IsEmpty(drr(6 + q, 1))
                        w = w + 1
                        arr(1, 1) = (0 + w) & "."
                        arr(1, 2) = "Заземляющий электрод в районе опоры ВЛ-0,4 кВ " & drr(6 + q, 1)
                        arr(1, 3) = "Стальной выпуск опоры " & drr(6 + q, 1)
                        
                        With .Sheets("Лист14")
                            .Cells(21 + w, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
                            .Range(.Cells(21 + w, 4), .Cells(21 + w, 5)).Merge
                            .Range(.Cells(21 + w, 7), .Cells(21 + w, 8)).Merge
                            .Range(.Cells(21 + w, 9), .Cells(21 + w, 10)).Merge
                            .Range(.Cells(21 + w, 4), .Cells(21 + w, 5)).Borders.LineStyle = xlContinuous
                            .Range(.Cells(21 + w, 7), .Cells(21 + w, 8)).Borders.LineStyle = xlContinuous
                            .Range(.Cells(21 + w, 9), .Cells(21 + w, 10)).Borders.LineStyle = xlContinuous
                        End With
                        q = q + 1
                        If 6 + q > UBound(drr, 1) Then Exit Do
                    Loop
                End If
            End If
        Next
    End With
End Sub
Нужно расширить возможности макроса, Не очень удобный существующий макрос для печати
 
Код
Sub четырнадцать2()
Dim vv As Variant
Dim q, w As Integer
  
w = 0
For Each vv In Array(5, 6, 7)
    If Workbooks("исполнительная.xlsm").Sheets("Даные").Cells(6 + q, vv).Value <> " " Then
        q = 1
        Do While Not IsEmpty(Workbooks("исполнительная.xlsm").Sheets("Даные").Cells(6 + q, vv).Value)
            w = w + 1
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 1).Value = (0 + w) & "."
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 2).Value = "Заземляющий электрод в районе опоры ВЛ-0,4 кВ " & Workbooks("исполнительная.xlsm").Sheets("Даные").Cells(6 + q, vv).Value
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 3).Value = "Стальной выпуск опоры " & Workbooks("исполнительная.xlsm").Sheets("Даные").Cells(6 + q, vv).Value
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 4).Value = "Сварка"
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 6).Value = "200"
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 7).Value = "0.04"
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Cells(21 + w, 9).Value = "годно"
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 4), Cells(21 + w, 5)).Merge
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 7), Cells(21 + w, 8)).Merge
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 9), Cells(21 + w, 10)).Merge
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 4), Cells(21 + w, 5)).Borders.LineStyle = xlContinuous
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 7), Cells(21 + w, 8)).Borders.LineStyle = xlContinuous
            Workbooks("исполнительная.xlsm").Sheets("Лист14").Range(Cells(21 + w, 9), Cells(21 + w, 10)).Borders.LineStyle = xlContinuous
            q = q + 1
        Loop
    End If
Next
  
End Sub

Цитата
написал:
Наверно я не так все вам объяснил. Постараюсь сделать это при помощи скринов.
Правильно: я не так все вам объяснил, я сделал это при помощи скринов.
Приведение времени внутри суток к 24-часовому виду, с помощью VBA
 
Цитата
написал:
Пока заказ НЕ занимаю.
Пишу в личку.
Сделал.
Оплату получил.
Изменено: МатросНаЗебре - 16.06.2022 20:21:38
Сборка сумм и уникальных значений с данных со всех листов книги Excel в одну таблицу
 
Код
Sub Собрать()
    Const RESULT_SHEET_NAME = "ОТЧЕТ"

    Dim wb As Workbook
    Set wb = ActiveWorkbook

    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If sh.Name <> RESULT_SHEET_NAME Then
            CollectFromSheet sh, dic, 6, [B1].Column, [CY1].Column
        End If
    Next
    Dim arr As Variant
    arr = DicToArr(dic)
    PrintResult wb.Sheets(RESULT_SHEET_NAME).Range("B6"), arr
End Sub

Private Function DicToArr(dic As Object) As Variant
    Dim arr As Variant
    If dic.Count = 0 Then
        ReDim arr(1 To 1, 1 To 2)
    Else
        ReDim arr(1 To dic.Count, 1 To 2)
        Dim brr As Variant
        brr = Array(dic.Keys(), dic.Items())
        Dim yy As Long
        Dim xx As Long
        For yy = 1 To UBound(arr, 1)
            For xx = 1 To UBound(arr, 2)
                arr(yy, xx) = brr(xx - 1)(yy - 1)
            Next
        Next
    End If
    DicToArr = arr
End Function

Private Sub PrintResult(rn As Range, arr As Variant)
    Application.EnableEvents = False
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    
    rn.Resize(rn.Parent.UsedRange.Rows.Count, UBound(arr, 2)).ClearContents
    rn.Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
    Application.Calculation = Application_Calculation
    Application.EnableEvents = True
End Sub

Private Sub CollectFromSheet(sh As Worksheet, dic As Object, y1 As Long, xID As Long, xVa As Long)
    Dim arr As Variant
    Dim yy As Long
    Dim dd As Double
    Dim ss As String
    With sh
        yy = .Cells(.Rows.Count, xID).End(xlUp).Row
        If yy >= y1 Then
            Dim aID As Variant
            Dim aVa As Variant
            aID = .Cells(1, xID).Resize(yy)
            aVa = .Cells(1, xVa).Resize(yy)
            For yy = y1 To UBound(aID, 1)
                ss = ""
                dd = 0
                On Error Resume Next
                ss = aID(yy, 1)
                dd = aVa(yy, 1)
                On Error GoTo 0
                If dd <> 0 Then
                    If ss <> "" Then
                        dic.Item(ss) = dic.Item(ss) + dd
                    End If
                End If
            Next
        End If
    End With
End Sub
Нужно расширить возможности макроса, Не очень удобный существующий макрос для печати
 
Код
Sub четырнадцать()
Dim vv As Variant
Dim q, w As Integer
 
w = 0
For Each vv In Array(5, 6, 7)
    If Workbooks("исполнительная").Sheets("Даные").Cells(6 + q, 6).Value <> " " Then
        q = 1
        Do While Not IsEmpty(Workbooks("исполнительная").Sheets("Даные").Cells(6 + q, vv).Value)
            w = w + 1
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 1).Value = (0 + q) & "."
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 2).Value = "Заземляющий электрод в районе опоры ВЛ-0,4 кВ " & Workbooks("исполнительная").Sheets("Даные").Cells(6 + q, vv).Value
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 3).Value = "Стальной выпуск опоры " & Workbooks("исполнительная").Sheets("Даные").Cells(6 + q, vv).Value
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 4).Value = "Сварка"
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 6).Value = "200"
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 7).Value = "0.04"
            Workbooks("исполнительная").Sheets("Лист14").Cells(21 + q, 9).Value = "годно"
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 4), Cells(21 + q, 5)).Merge
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 7), Cells(21 + q, 8)).Merge
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 9), Cells(21 + q, 10)).Merge
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 4), Cells(21 + q, 5)).Borders.LineStyle = xlContinuous
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 7), Cells(21 + q, 8)).Borders.LineStyle = xlContinuous
            Workbooks("исполнительная").Sheets("Лист14").Range(Cells(21 + q, 9), Cells(21 + q, 10)).Borders.LineStyle = xlContinuous
            q = q + 1
        Loop
    End If
Next
 
End Sub
Создать макрос для Excel
 
Всю зебру уже исписали )
Создать макрос для Excel
 
Написал Заказчику в почту.
Создать макрос для Excel
 
Что у вас тут происходит?! )
Удаление использованных данных из выпадающего списка и прописывание их в отдельную таблицу
 
Создаём имя Номера2
Код
=СМЕЩ(Лист2!$J$1;1;0;Лист2!$J$1;1)
Это имя ставим в проверку данных.

На Лист2 создаём дополнительные столбцы
Код
H2        =H1+(Номера<>0)
I2        =Номера
J2        =ВПР(СТРОКА(J1);H:I;2;0)
Тянем вниз

В J1 вносим формулу
Код
=МАКС(H:H)




Цитата
написал:
А без макроса нельзя как то
Можно. Но выглядит как минимум необычно, использовать макрос и в середине "не использовать макрос".
Поиск значение с использованием условия максимум
 
С этим условием
Цитата
написал:
Если изменения произошли в один день, то за цену берем максимальной число.
На листе изменения добавляем столбец в таблицу
Код
D1     ЦЕНА2
D2     =МАКС((A2=[КОД])*(C2=[ДАТА ИЗМЕНЕНИЯ])*[ЦЕНА])    (формула массива)
Код
ЦЕНЫ!B2       =ИНДЕКС(Таблица1[[#Все];[ЦЕНА2]];МАКС((Таблица1[ДАТА ИЗМЕНЕНИЯ]=МАКС((A2=Таблица1[КОД])*Таблица1[ДАТА ИЗМЕНЕНИЯ]))*СТРОКА(Таблица1[ДАТА ИЗМЕНЕНИЯ])))
формула массива.
Поиск значение с использованием условия максимум
 
Формула массива
Код
=ИНДЕКС(Таблица1[[#Все];[ЦЕНА]];МАКС((Таблица1[ДАТА ИЗМЕНЕНИЯ]=МАКС((A2=Таблица1[КОД])*Таблица1[ДАТА ИЗМЕНЕНИЯ]))*СТРОКА(Таблица1[ДАТА ИЗМЕНЕНИЯ])))
без
Цитата
написал:
Если изменения произошли в один день, то за цену берем максимальной число.
Изменено: МатросНаЗебре - 10.06.2022 14:17:18
Удаление использованных данных из выпадающего списка и прописывание их в отдельную таблицу
 
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B1:B5")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range, sh As Worksheet
                
                Dim ValidFormula As String
                'ValidFormula = "=Номера"
                Set sh = Worksheets("Лист2")
                ValidFormula = GetValidFormula(sh, [A1].Value)
                Set cell = sh.Cells.Find(Target)
                Application.EnableEvents = False
                cell.Delete Shift:=xlUp
                Dim xtb2 As Long
                xtb2 = sh.ListObjects("Таблица2").Range.Column
                If sh.Cells(2, xtb2) = "" Then
                    sh.Cells(2, xtb2) = Target
                Else
                    lr = sh.Cells(Rows.Count, xtb2).End(xlUp).Row - 1
                    sh.Cells(lr, xtb2).ListObject.ListRows.Add AlwaysInsert:=True
                    sh.Cells(lr + 1, xtb2).Value = Target
                End If
                Application.EnableEvents = True
                With Range("B1:B5").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ValidFormula
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
 End If
End Sub

Function GetValidFormula(sh As Worksheet, colName As String) As String
    Dim arr As Variant
    On Error Resume Next
    arr = sh.ListObjects("Таблица1").ListColumns(colName).DataBodyRange.Resize(, 2)
    On Error GoTo 0
    If Not IsEmpty(arr) Then
        Dim brr As Variant
        Dim yy As Long
        Dim uu As Long
        Dim ii As Long
        For ii = 0 To 1
            uu = 0
            For yy = 1 To UBound(arr, 1)
                If Not IsEmpty(arr(yy, 1)) Then
                    uu = uu + 1
                    If ii Then
                        brr(uu) = arr(yy, 1)
                    End If
                End If
            Next
            If uu Then
                If ii Then
                    GetValidFormula = Join(brr, ",")
                Else
                    ReDim brr(1 To uu)
                End If
            End If
        Next
    End If
End Function
Макросом в таблице на против наименования проставить код
 
Ещё вариант.
Код
Option Explicit

Const findWhat = "Опасность психических нагрузок, стрессов (при аварийной ситуации)"
Const s2 = "С8 (Ч4 x Т2)"

Sub Заменить()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    FindInSheet ActiveSheet
    
    Application.Calculation = Application_Calculation
End Sub

Sub FindInSheet(sh As Worksheet)
    With sh.UsedRange
        Dim FoundCell As Range
        Dim LastCell As Range
        Dim FirstAddr As String
        Set LastCell = .Cells(.Rows.Count, .Columns.Count)
        Set FoundCell = .Find(what:=findWhat, after:=LastCell)
         
        If Not FoundCell Is Nothing Then
            FirstAddr = FoundCell.Address
        End If
        Do Until FoundCell Is Nothing
            FoundCellJob FoundCell
            Set FoundCell = .FindNext(after:=FoundCell)
            If FoundCell.Address = FirstAddr Then
                Exit Do
            End If
        Loop
    End With
End Sub
 
Sub FoundCellJob(cl As Range)
    cl.Cells(1, 7).Value = s2
End Sub
Удаление использованных данных из выпадающего списка и прописывание их в отдельную таблицу
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B1:B5")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range, sh As Worksheet
                Dim ValidFormula As String
                ValidFormula = "=Номера"
                Set sh = Worksheets("Лист2")
                Set cell = sh.Cells.Find(Target)
                Application.EnableEvents = False
                cell.Delete Shift:=xlUp
                Dim xtb2 As Long
                xtb2 = sh.ListObjects("Таблица2").Range.Column
                If sh.Cells(2, xtb2) = "" Then
                    sh.Cells(2, xtb2) = Target
                Else
                    lr = sh.Cells(Rows.Count, xtb2).End(xlUp).Row - 1
                    sh.Cells(lr, xtb2).ListObject.ListRows.Add AlwaysInsert:=True
                    sh.Cells(lr + 1, xtb2).Value = Target
                End If
                Application.EnableEvents = True
                With Range("B1:B5").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ValidFormula
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
 End If
End Sub
Скрытие строк на нескольких листах при помощи макроса, Скрытие строк на нескольких листах при помощи макроса
 
Код
Option Explicit

Const findWhat = "x"

Sub HideRows()
    FindInWb ActiveWorkbook
End Sub

Sub ShowRows()
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Worksheets
        sh.UsedRange.EntireRow.Hidden = False
    Next
End Sub

Sub FindInWb(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        FindInSheet sh
    Next
End Sub

Sub FindInSheet(sh As Worksheet)
    With sh.UsedRange
        Dim FoundCell As Range
        Dim LastCell As Range
        Dim FirstAddr As String
        Set LastCell = .Cells(.Rows.Count, .Columns.Count)
        Set FoundCell = .Find(what:=findWhat, after:=LastCell)
        
        If Not FoundCell Is Nothing Then
            FirstAddr = FoundCell.Address
        End If
        Do Until FoundCell Is Nothing
            FoundCellJob FoundCell
            Set FoundCell = .FindNext(after:=FoundCell)
            If FoundCell.Address = FirstAddr Then
                Exit Do
            End If
        Loop
    End With
End Sub

Sub FoundCellJob(cl As Range)
    cl.EntireRow.Hidden = True
End Sub
Удаление использованных данных из выпадающего списка и прописывание их в отдельную таблицу
 
Цитата
написал:
использованные номера прописывались именно в таблицу2, а не в столбец этой таблицы?
Не понял, нужен пример.
Копировать столбец умной таблицы в другую умную таблицу vba
 
Код
Sub CopyListObjectsColumn()
    Dim tb1 As ListObject
    Set tb1 = Workbooks("Реестр Претензионного отдела.xlsm").Sheets("РЕЕСТР").ListObjects("Таблица4")
      
    Dim tb2 As ListObject
    Set tb2 = Workbooks("Портянка.xlsm").Sheets("Лист1").ListObjects("Таблица1")
      
    Dim arr As Variant
      
    Dim colName As Variant
    On Error Resume Next
    For Each colName In Array("№п/п", "ЖК", "Корпус", "Тип помещения", "Номер помещения", "Отделка", "Этап получения замечания", "Дата обращения", "Общий статус обращения", "Замечание клиента", "Статус замечания", "Исполнитель", "Время устранения", "Статус ТМЦ", "Статус материалов", "Комментарии", "Столбец1")
        arr = tb1.ListColumns(colName).DataBodyRange
        tb2.ListColumns(colName).DataBodyRange.Resize(tb1.ListColumns(colName).DataBodyRange.Rows.Count, 1).Value = arr
        If Err Then
            MsgBox "Проверьте столбец " & colName, vbCritical
            Exit For
        End If
    Next
    On Error GoTo 0
End Sub
Странно, что макрос до строки 9 дошёл. В третьей строке не указано расширение файла.
Cгруппировать данные в сжатой форме как сводной таблице, Реализовать при помощи формул не используя макросов и сводных таблиц
 
Код
C2      =C1+(A2<>A1)*(СЧЁТЕСЛИМН(A:A;A1)+1)
D2      =ЕСЛИ(C2=C1;D1+1;C2)
E2      =ЕСЛИОШИБКА(ЕСЛИОШИБКА(ИНДЕКС($B$1:$B$14;ПОИСКПОЗ(СТРОКА();$D$1:$D$14;0));ИНДЕКС($A$1:$A$14;ПОИСКПОЗ(СТРОКА()+1;$D$1:$D$14;0)));"")
И протянуть вниз.
Удаление использованных данных из выпадающего списка и прописывание их в отдельную таблицу
 
Можно заменить формулу "Номера" на
Код
=ДВССЫЛ("Таблица1["&Лист1!$A$1&"]")
Всплывающее окно при наведении на ячейку, Отобразить всплывающее окно с информацией из неактивной таблицы при наведении на ячейку
 
Точно. Так лучше. Ну и, как вариант, можно дополнить на случай, если активная ячейка будет не в первом столбце.
Код
 .Left = ActiveCell.Left + ActiveCell.Width + 10
Копировать столбец умной таблицы в другую умную таблицу vba
 
В таблице
Код
 Workbooks("Реестр Претензионного отдела").Sheets("РЕЕСТР").ListObjects("Таблица4")
нет элемента из массива "№п/п", "ЖК", "Корпус", "Тип помещения", "Номер помещения", "Отделка", "Этап получения замечания", "Дата обращения", "Общий статус обращения", "Замечание клиента", "Статус замечания", "Исполнитель", "Время устранения", "Статус ТМЦ", "Статус материалов", "Комментарии", "Столбец1"
Расчет платежей при меняющейся отсрочке
 
Цитата
написал:
колонка с итогом за 22 год мне там все портит, ее надо убрать?
Не во всём эта колонка виновата, можно не убирать )
Копировать столбец умной таблицы в другую умную таблицу vba
 
Цитата
написал:
оно нормально будет работать?
Время ожидания ответа с форума заведомо больше, чем время эксперимента )
Расчет платежей при меняющейся отсрочке
 
Цитата
написал:
когда через год переносится платеж
Код
=СУММ(ЕСЛИОШИБКА((МЕСЯЦ(B5)-МЕСЯЦ($B$5:$Z$5)+12*(ГОД(B5)-ГОД($B$5:$Z$5))=$B$1:$Z$1);0)*($B$6:$Z$6))
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 152 След.
Наверх