У меня написан макрос, который удаляет использованные данные из раскрывающегося списка Листа2 столбца B и прописывает их столбец C Листа2, но проблема в том, что при создании итоговой строки, удаленные данные прописываются после итоговой строки, а не до, не знаете, как сделать так, чтобы при удалении использованных данных, итоговая строка опускалась бы ниже?
Ибрагим Белхороев, самый простой вариант, поместить итоги в первую строку
или так (вставить пустую строку в сводной и поместить туда необходимое значение):
Код
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
есть такой момент, когда в таблице перед итоговой строкой остаётся пустая строка, то использованные данные из выпадающего списка прописываются в саму итоговую строку, не знаете, как решить эту проблему?
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, просто они удобнее, когда нужно добавлять или удалять данные, к сожалению я изначально не додумался их использовать. Я относительно новичок в Excel, поэтому порой сразу не догадываюсь, что прицип решения определенной задачи мог быть значительно проще.
RAN, а вот такой ещё момент, когда я выбираю последнее оставшееся значение из выпадающего списка, Excel начинает ругаться на эту строку:
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
evgeniygeo, код работает, спасибо вам, вот только одна проблема, дело в том, что когда в источнике данных выпадающего списка я выбираю одно оставшееся значение, Excel начинает ругаться на эту строку: