2016-06-14 128 views
1

我想在Excel中設置一個宏,它將爲數據透視表選擇一個範圍。唯一的區別是從不相同。這一切都取決於已經寫了多少支票。我想要它的工作方式是按CTRL向下箭頭,然後備份兩次以開始選擇。然後從那裏切換到f欄,然後按住Control Up選擇範圍。這是我想要在數據透視表中的數據的屏幕截圖。宏的代碼低於數據。如何在Excel中爲宏指定一個動態範圍

Bank Account      
Checks Check Number  Date  Amount Reterence  Reconciled? 
      2002  6/3/2016 -20.00  Fred    C 
      2003  6/3/2016 -30.00  George   N 
      2004  6/3/2016 -40.00  Sue    N 
      2005  6/3/2016 -50.00  Greg    C 
      2006  6/3/2016 -10.00  McDonalds  C 
      2007  6/3/2016 -20.00  Wendys   N 
      2008  6/3/2016 -30.00  KFC    C 
      2009  6/3/2016 -40.00  WalMart   C 
      2006  6/3/2016 -50.00  Kmart   C 
      2007  6/3/2016 -60.00  Kroger   N 
      2008  6/3/2016 -70.00  Dollar General N 
      2009  6/3/2016 -80.00  Sears   C 
Check Total      -$500.00   

Deposits      
         11/3/2014  50.00  Deposit   Y 
         11/3/2014  60.00  Deposit   Y 
         11/3/2014  70.00  Deposit   Y 
         11/3/2014  80.00  Deposit   Y 
         11/3/2014  10.00  Deposit   Y 
         11/3/2014  20.00  Deposit   Y 
         11/3/2014  30.00  Deposit   Y 

,代碼:

Range("A4").Select 
Selection.End(xlDown).Select 
Range("A4").Select 
Selection.End(xlDown).Select 
Range("A15").Select 
Range(Selection, Selection.End(xlUp)).Select 
Range(Selection, Selection.End(xlToRight)).Select 
Range(Selection, Selection.End(xlToRight)).Select 
Range(Selection, Selection.End(xlToRight)).Select 
Range(Selection, Selection.End(xlToRight)).Select 
Range(Selection, Selection.End(xlToLeft)).Select 
Sheets.Add 
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    "Sheet1!R3C1:R15C6", Version:=xlPivotTableVersion10).CreatePivotTable _ 
    TableDestination:="Sheet2!R3C1", TableName:="PivotTable3", DefaultVersion _ 
    :=xlPivotTableVersion10 
Sheets("Sheet2").Select 
Cells(3, 1).Select 
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables(_ 
    "PivotTable3").PivotFields("Amount"), "Sum of Amount", xlSum 
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Reconciled?") 
    .Orientation = xlRowField 
    .Position = 1 
End With 
Range("D3").Select 
+0

不能只要運行'評估(「MATCH(MAX(B: B),B:B,0)「)'得到最後使用的行(假設最低的值是最高的)? –

+0

謝謝,德克。我試圖找出編輯。 –

+0

我想在所有支票上做一個數據透視表,但支票的數量從不相同。 –

回答

0

威爾遜,

我相信這將會回答你的問題。我有一個類似的問題,並設法實現一個解決方案,當然你需要根據你的具體需求調整代碼(或者僱用我)。

我花了差不多半天的時間來完成和記錄這個例子,所以請在提問前仔細閱讀代碼註釋。

由於您沒有提供Excel示例,我盡我最大的努力模擬了您擁有的文件並瞭解其目的。有幾個步驟來完成你想要的,也許最重要的(並且首先難以獲得)是動態範圍。如果您有任何疑問,請仔細閱讀代碼註釋和源代碼。

您需要設置一個動態範圍並將該範圍用作創建數據透視表的參考(說起來容易做起來難)。祝你好運,讓我知道這是否有助於你。

工作實例可以在這裏下載表格: https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm

下面是該項目創建的代碼:

Option Explicit 

Public Sub DynamicRange() 

    '--------------------------------------------------------------------------------------- 
    ' Method : DynamicRange 
    ' Author : vicsar 
    ' Date : 6/15/2016 
    ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation 
    ' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel 
    ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office) 
    ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand 
    ' how the dinamic range works 
    ' Working example can be downloaded form here: 
    ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm 
    '--------------------------------------------------------------------------------------- 

    On Error GoTo MistHandler 

    ' Let's begin by handling posible human errors 
    ' Check if the RawData sheet exists, if it doesn't then warn the user 
    If WorksheetExists("RawData") = False Then 
     MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _ 
       & Chr$(13) _ 
       & Chr$(13) _ 
       & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says" 
     Exit Sub 
    End If 

    ' Check if the PivotReport sheet exists, if it does then warn the user 
    If WorksheetExists("PivotReport") = True Then 
     MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says" 
     Exit Sub 
    End If 

    ' Using this will make the procedure run faster. You won't be able to see what the macro is doing, 
    ' but it will run faster, specially beneficial when you have thousands of rows. 
    Application.ScreenUpdating = False 

    ' Aesthetics 
    Sheets("RawData").Select 
    ActiveWindow.DisplayGridlines = False 
    With ActiveWorkbook.Sheets("RawData").Tab 
     .ThemeColor = xlThemeColorAccent5 
     .TintAndShade = 0 
    End With 

    ' Let's begin by creatign a dynamic reference for the pivot report 
    ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand. 
    ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box, 
    ' to select the range on the worksheet. 
    ' If the Named Data Range exist it will be re-writen 
    ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4)) 
    ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _ 
          "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))" 
    ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand." 


    ' Add destination sheet for the pivot table 
    Worksheets.Add().Name = "PivotReport" 
    Sheets("PivotReport").Select 

    ' This example shows how to add a pivot table based on the dynamic range. 
    ' You will have to manually arrange the PivotTable fields 
    'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    '  "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ 
    '  TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ 
    '  DefaultVersion:=xlPivotTableVersion15 
    'Sheets("PivotReport").Select 
    'Cells(1, 1).Select 

    ' This example shows how to add a pivot table based on the dynamic range. 
    ' The PivotTable fields are set for the user 
    ' 
    ' Inserting the Pivot Table 
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
             "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ 
             TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ 
             DefaultVersion:=xlPivotTableVersion15 
    Sheets("PivotReport").Select 
    Cells(1, 1).Select 

    ' Defining the PivotTable fields 
    ' Adding fields to the ROWS area 
    With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields(_ 
     "Reconciled?") 
     .Orientation = xlRowField 
     .Position = 1 
    End With 

    ' Adding fields to the VALUES area 
    ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _ 
                    PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _ 
                    xlSum 
    ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use 
    ' the same field on the ROWS and VALUES areas 
    With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount") 
     .Orientation = xlRowField 
     .Position = 2 
    End With 

    ' Refreshing the Pivot Table cache 
    ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh 

    ' Moar Aesthetics 
    With ActiveWorkbook.Sheets("PivotReport").Tab 
     .ThemeColor = xlThemeColorAccent6 
     .TintAndShade = 0 
    End With 
    ActiveWindow.DisplayGridlines = False 

    ' Allowing screen updates again 
    Application.ScreenUpdating = True 

    MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says" 


    On Error GoTo 0 
    Exit Sub 

MistHandler: 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says" 

End Sub 

Public Function WorksheetExists(ByVal strWorksheetName As String) As Boolean 
    '--------------------------------------------------------------------------------------- 
    ' Method : WorksheetExists 
    ' Author : vicsar 
    ' Date : 6/16/2016 
    ' Purpose: Boolean - Checks if a worksheet exists 
    '--------------------------------------------------------------------------------------- 

    On Error GoTo MistHandler 

    Dim objSheet As Worksheet 

    For Each objSheet In ThisWorkbook.Worksheets 
     If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then 
      WorksheetExists = True 
      Exit Function 
     End If 
    Next objSheet 

    WorksheetExists = False 


    On Error GoTo 0 
    Exit Function 

MistHandler: 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says" 

End Function 
相關問題