Выполнение процедуры сброса списка не удаляет строку итогов или содержащиеся в ней формулы - PullRequest
0 голосов
/ 10 июля 2019

Итак, я получил довольно шикарный фрагмент кода ниже этого форума и немного его изменил. Он идеален тем, что удаляет все строки таблицы, кроме одной, и оставляет эту строку без значений, кроме всех ранее содержащихся формул. Тем не менее, он также удаляет итоговую строку, которая мне нужна, чтобы остаться на месте со всеми ее формулами.

Ничто из того, что я пробовал, ничего не сделало, кроме как заставить этот код не выполнять другую половину своей работы - очистку таблицы.

Sub ListReset(lst As ListObject)        ''clears a listobject while leaving one empty row and formulas
On Error Resume Next
With lst
  If .ShowAutoFilter Then .AutoFilter.ShowAllData
  If .DataBodyRange.Rows.Count = 1 Then Exit Sub ' Table is already clear
    .DataBodyRange.Offset(1).Rows.Clear
  If .DataBodyRange.Columns.Count > 1 Then ' Check to see if SpecialCells is going to evaluate just one cell.
    .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
  ElseIf Not .Range.HasFormula Then   ' Only one cell in range and it does not contain a formula.
    .DataBodyRange.Rows(1).ClearContents
  End If

  .Resize .Range.Rows("1:2")
  .HeaderRowRange.Offset(1).Select        ' Reset used range on the sheet
        Dim X
        X = .Range.Worksheet.UsedRange.Rows.Count
End With
End Sub

1 Ответ

0 голосов
/ 10 июля 2019

Возможно, вы захотите включить проверку того, что в строке Всего отображается:

Sub ListReset(lst As ListObject)        ''clears a listobject while leaving one empty row and formulas

On Error Resume Next

With lst
    If .ShowAutoFilter Then .AutoFilter.ShowAllData
    If .DataBodyRange.Rows.Count = 1 Then Exit Sub ' Table is already clear
    If .ShowTotals Then
        .DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1).Rows.Clear
    Else
        .DataBodyRange.Offset(1).Rows.Clear
    End If
    If .DataBodyRange.Columns.Count > 1 Then ' Check to see if SpecialCells is going to evaluate just one cell.
        .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    ElseIf Not .Range.HasFormula Then   ' Only one cell in range and it does not contain a formula.
        .DataBodyRange.Rows(1).ClearContents
    End If
    .Resize .Range.Rows("1:2")
    .HeaderRowRange.Offset(1).Select        ' Reset used range on the sheet
End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...