Детализация сводной таблицы Excel до одного листа (помощь с моим текущим кодом) - PullRequest
0 голосов
/ 26 сентября 2018

Добрый день,

У меня есть отчет с сводной таблицей в Excel.Мой менеджер попросил, чтобы при двойном щелчке в сводной таблице исходные данные не появлялись каждый раз на новом листе.Будучи нубом VBA, мне удалось получить помощь онлайн, и у меня есть следующий код, который работает, однако мне нужна некоторая помощь, чтобы настроить его, чтобы получить желаемый результат.Пожалуйста, кто-нибудь может мне помочь.

Текущий код рабочей книги:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If CS <> "" Then
With Application
ScreenUpdating = False
Dim NR&
With Sheets("DrillDown")
If WorksheetFunction.CountA(.Rows(1)) = 0 Then
NR = 1
Else
NR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, 
SearchDirection:=xlPrevious).Row + 2
End If
Range("A1").CurrentRegion.Copy .Cells(NR, 1)
End With
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
 Sheets(CS).Select
.ScreenUpdating = True
End With
End If
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target 
As Range, Cancel As Boolean)
If ActiveSheet.Name = "Movement Of Stock" Then
CS = "Movement Of Stock"
ElseIf ActiveSheet.Name = "DrillDown" Then
If Not IsEmpty(Target) Then
If Target.Row > Range("A1").CurrentRegion.Rows.Count + 1 _
Or Target.CurrentRegion.Cells(1, 1).Address = "$A$1" Then
Cancel = True
With Target.CurrentRegion
.Resize(.Rows.Count + 1).EntireRow.Delete
End With
End If
End If
End If
End Sub

Текущий код модуля:

Public CS$

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

1) Я хотел бы, чтобы каждый раз, когда я дважды щелкал по сводной таблице, сначала очищались все данные на рабочем листе DrillDown, а затем добавлялись новые данные (другими словами, я не хочу, чтобы данныескладывать из каждого двойного клика).

2) Текущий код также возвращает пользователя обратно в сводную таблицу после двойного щелчка.Я бы хотел, чтобы пользователь попал на страницу DrillDown.

Большое спасибо за помощь!

1 Ответ

0 голосов
/ 26 сентября 2018

Я полагаю, что вы можете удовлетворить свои 2 требования, просто внеся изменения в событие NewSheet.

Я прокомментировал изменения, чтобы сделать это само за себя (?)

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If CS <> "" Then
    With Application
        ScreenUpdating = False
        Dim NR&
        With Sheets("DrillDown")

            'Set this to always start at the top of the page
            NR = 1
            '..and to clear the Drilldown tab..
            .Cells.ClearContents

            'instead of this..
            '   If WorksheetFunction.CountA(.Rows(1)) = 0 Then
            '   NR = 1
            'Else
            '   NR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2
            'End If

            Range("A1").CurrentRegion.Copy .Cells(NR, 1)

        End With
        .DisplayAlerts = False
        ActiveSheet.Delete
        .DisplayAlerts = True
        'Below is commented out to stop user being returned to Pivot
        ' Sheets(CS).Select 
        .ScreenUpdating = True
        End With
    End If
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...