198188

帖子: 405
主題: 58
精華: 0
積分: 489
點名: 25
作業系統: win7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-5-9

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2023-11-4 16:33 | 只看該作者

樞紐分析表-排序

請問如何將該表格用樞紐分析表做成圖2？

年份 = 可以根據源數據裏的年份選擇
選擇年份后
會左邊按照該年份的GDP金額自動排序頭10個。
然後右邊根據左邊的表格自動生成棒形圖

2.jpg (386.91 KB)

2.zip (16.12 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2808
主題: 10
精華: 0
積分: 2864
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-5-8

2^#

發表於 2023-11-5 14:54 | 只看該作者

樞紐分析表幾乎沒用到, 複製再排序即可

Xl0000096.rar (19.64 KB)

TOP

198188

中學生 Rank: 2

帖子: 405
主題: 58
精華: 0
積分: 489
點名: 25
作業系統: win7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-5-9

3^#

發表於 2023-11-5 15:44 | 只看該作者

樞紐分析表幾乎沒用到, 複製再排序即可
准提部林發表於 2023-11-5 14:54

請問有沒有比較簡單的方法來表達出結果？
另外有沒有功能是當REPORT 裏面的"B1" 年份更改后，自動運行VBA, 不用再去按RUN?

Sub Report()
Dim I As Integer, Last As Integer
Dim Frng As Range, Rng As Range
Sheets("Data").Select
Columns("N:CE").Select
Selection.ClearContents


Sheets("Data").Select
Range("A1:L50").Select
Selection.Copy
Sheets("Data").Select
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=True
      With Selection.Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = 0
End With
Sheets("Data").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Report").Select
Columns("E:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
Sheets("Report").Select
Range("F2").Select
Application.CutCopyMode = False

Last = Sheets("Report").Range("E1").CurrentRegion.Rows.Count

For I = 2 To Last

Sheets("Report").Range("F" & I).Value = Application.VLookup(Range("B1"), Sheets("Data").Range("N:CC"), I, False)
Next I
   Columns("E:F").Select
ActiveWorkbook.Worksheets("Report").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Report").Sort.SortFields.Add2 Key:=Range("F2:F52") _
      , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Report").Sort
      .SetRange Range("E1:F52")
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
End With
Range("E12:F500").Select
Selection.ClearContents
Range("B1").Select

End Sub

图表源数据VBA动态图.rar (40.86 KB)

TOP

198188

中學生 Rank: 2

帖子: 405
主題: 58
精華: 0
積分: 489
點名: 25
作業系統: win7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-5-9

4^#

發表於 2023-11-5 16:01 | 只看該作者

樞紐分析表幾乎沒用到, 複製再排序即可
准提部林發表於 2023-11-5 14:54

感謝，請問能不能根據年份在圖表上加插年份？如附圖
另外可否輸入年份后，自己運行VBA?

1.jpg (386.91 KB)

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

5^#

發表於 2023-11-6 08:06 | 只看該作者

回復 1# 198188
回復 2# 准提部林

謝謝 198188前輩發表此主題與範例,謝謝准提部林前輩指導
後學學習心得如下,請前輩再指導

清除舊資料:

執行結果:

Sub Test_A1()
Dim R&, C
'↑宣告變數:R是長整數,C是通用型變數
C = Application.Match([c1], Sheet1.[1:1], 0)
'↑令C這通用型變數是以Match()方法回傳[C1]儲存格值在Sheet1(源數据)表.[1:1]的位置
https://learn.microsoft.com/zh-t ... sheetfunction.match
If IsError(C) Then Exit Sub
'↑如果以IsError 函數判斷 C變數回傳(TRUE):是錯誤值,就結束程式執行
R = Sheet1.[a65536].End(3).Row - 1
'↑令R這長整數變數是 Sheet1(源數据)A欄最後一個有內容儲存格列號-1
With [c4].Resize(R, 2)
'↑以下是關於 [C4]儲存格擴展向下R變數列,擴展向右2欄範圍儲存格的程序
   .Columns(1) = Sheet1.[a2].Resize(R).Value
   '↑令該範圍儲存格第1欄儲存格值是 Sheet1(源數据)表.[A2]擴展向下R變數列儲存格值
   .Columns(2) = Sheet1.Cells(2, C).Resize(R).Value
   '↑令該範圍儲存格第2欄儲存格值是 Sheet1(源數据)表第 C變數欄/第2列儲存格,
   '向下R變數列儲存格值
   .Sort Key1:=.Item(2), Order1:=xlDescending, Header:=xlNo
   '↑令該範圍以第2欄做沒有標題的漸減排序
   .Rows(11).Resize(R).ClearContents
   '↑令該區域第11列開始擴展向下R變數列的範圍儲存格內容清除
End With
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

6^#

發表於 2023-11-6 08:39 | 只看該作者

本帖最後由 Andy2483 於 2023-11-6 08:40 編輯

回復 4# 198188

後學建議以下方法
1.在圖表插入文字方塊,插入函數 =$C$1 作為文字方塊內容
2.觸發[C1]儲存格時自動執行程式碼

1.

2.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "C1" Then Call Test_A1
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188

中學生 Rank: 2

帖子: 405
主題: 58
精華: 0
積分: 489
點名: 25
作業系統: win7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-5-9

7^#

發表於 2023-11-6 08:50 | 只看該作者

回復 5# Andy2483

感謝前輩指導解惑

TOP

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 353
主題: 5
精華: 0
積分: 386
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-5-4

論壇榮譽勳章論壇贊助勳章

8^#

發表於 2023-11-7 00:28 | 只看該作者

回復 8# 198188

Sub test()
Set cn = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
cn.Open V & "Data Source=" & ThisWorkbook.FullName
q = "select top 10 " & Sheet1.[A1] & ", [" & Sheet2.[C1] & "] from [" & Sheet1.Name & "$A1:L]"
q = q & " order by [" & Sheet2.[C1] & "] desc"
Sheet2.[C4].CopyFromRecordset cn.Execute(q)
End Sub

Xl0000096.zip (22 Bytes)

TOP

198188