Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Итоговая строка опускается ниже в зависимости от добавления строк
 
#1
17.08.2021 08:11:09
У меня написан макрос, который удаляет использованные данные из раскрывающегося списка Листа2 столбца B и прописывает их столбец C Листа2, но проблема в том, что при создании итоговой строки, удаленные данные прописываются после итоговой строки, а не до, не знаете, как сделать так, чтобы при удалении использованных данных, итоговая строка опускалась бы ниже?
Изменено: Ибрагим Белхороев - 17.08.2021 08:22:41
 
 
 
#2
17.08.2021 08:21:26
Ибрагим Белхороев,
самый простой вариант, поместить итоги в первую строку

или так (вставить пустую строку в сводной и поместить туда необходимое значение):
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B13:B22")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range, sh As Worksheet
                Dim ValidFormula As String
                ValidFormula = "=OFFSET(Лист2!$B$2:$B$1048576,0,0,COUNTA(Лист2!$B$2:$B$1048576))"
                Set sh = Worksheets("Лист2")
                Set cell = sh.Cells.Find(Target)
                Application.EnableEvents = False
                cell.Delete Shift:=xlUp
                lr = sh.Cells(Rows.Count, 3).End(xlUp).Row - 1
                sh.Cells(lr, 3).ListObject.ListRows.Add AlwaysInsert:=True
                sh.Cells(lr + 1, 3).Value = Target
                Application.EnableEvents = True
                With Range("B13:B22").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
Изменено: evgeniygeo - 17.08.2021 08:25:58
 
 
 
#3
17.08.2021 08:27:43
evgeniygeo, спасибо вам большое, работает.

есть такой момент, когда в таблице перед итоговой строкой остаётся пустая строка, то использованные данные из выпадающего списка прописываются в саму итоговую строку, не знаете, как решить эту проблему?
 
 
 
#4
09.09.2021 10:31:11
Ибрагим Белхороев, у вас умные таблицы исключительно для красы?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B13:B22")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range

                With Worksheets("Лист2")
                    Set cell = .ListObjects("Таблица4").Range.Find(Target)
                    cell.Delete Shift:=xlUp
                    With .ListObjects("Таблица5").ListRows.Add(AlwaysInsert:=True)
                        .Range.Value = Target.Value
                    End With
                End With

                With Range("B13:B22").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=ishod"    'ValidFormula
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
End Sub
Изменено: RAN - 09.09.2021 10:32:24
 
 
 
#5
09.09.2021 11:11:06
RAN, просто они удобнее, когда нужно добавлять или удалять данные, к сожалению я изначально не додумался их использовать. Я относительно новичок в Excel, поэтому порой сразу не догадываюсь, что прицип решения определенной задачи мог быть значительно проще.

RAN, а вот такой ещё момент, когда я выбираю последнее оставшееся значение из выпадающего списка, Excel начинает ругаться на эту строку:
Код
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=ishod"
Не подскажете, как решить эту проблему?
Изменено: Ибрагим Белхороев - 09.09.2021 11:23:23
 
 
 
#6
09.09.2021 11:25:01
Не подскажу. У меня такой проблемы нет.
 
 
 
#7
09.09.2021 11:41:46
Ладно, спасибо вам за помощь.
 
 
 
#8
09.09.2021 12:18:38
Ибрагим Белхороев,
как вариант в лоб:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B13:B22")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range, sh As Worksheet
                Dim ValidFormula As String
                ValidFormula = "=OFFSET(Лист2!$B$2:$B$1048576,0,0,COUNTA(Лист2!$B$2:$B$1048576))"
                Set sh = Worksheets("Лист2")
                Set cell = sh.Cells.Find(Target)
                Application.EnableEvents = False
                cell.Delete Shift:=xlUp
                If sh.Cells(2, 3) = "" Then
                sh.Cells(2, 3) = Target
                Else
                lr = sh.Cells(Rows.Count, 3).End(xlUp).Row - 1
                sh.Cells(lr, 3).ListObject.ListRows.Add AlwaysInsert:=True
                sh.Cells(lr + 1, 3).Value = Target
                End If
                Application.EnableEvents = True
                With Range("B13:B22").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
 
 
 
#9
09.09.2021 12:30:46
evgeniygeo, код работает, спасибо вам, вот только одна проблема, дело в том, что когда в источнике данных выпадающего списка я выбираю одно оставшееся значение, Excel начинает ругаться на эту строку:
Код
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ValidFormula
предполагаю, что это происходит из-за того, что в источнике данных не остается больше значении, не знаете как это исправить?
 
 
 
#10
09.09.2021 13:56:02
Ибрагим Белхороев,
к сожалению, у меня ошибки нет, но как вариант, в начало кода поставить:
Код
On Error Resume Next
Изменено: evgeniygeo - 09.09.2021 13:56:14
 
 
 
#11
09.09.2021 14:01:10
evgeniygeo, помогло, спасибо вам большое.
 
 
 
Страницы: 1
Наверх