ListBox與排序加總問題 - Excel程式區

帖子: 192
主題: 15
精華: 0
積分: 194
點名: 0
作業系統: windows
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2016-9-22
最後登錄: 2020-8-28

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

9^#

發表於 2016-10-7 16:27 | 只看該作者

回復 7# stillfish00

回S大
方便放檔案給我看嗎
我加上去後一直出現錯誤><"

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

8^#

發表於 2016-10-7 09:25 | 只看該作者

回復 6# starbox520
4# 漏了 i=i+1

你再改第一行的資料範圍就好了
Set rngData = Sheets("工作表2").Range("A1:G33")

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

帖子: 192
主題: 15
精華: 0
積分: 194
點名: 0
作業系統: windows
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2016-9-22
最後登錄: 2020-8-28

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

7^#

發表於 2016-10-7 00:34 | 只看該作者

回復 4# stillfish00

回大大因為我沒用過樞紐分析表
剛剛試了好幾回都弄不出來
如果用此功能
資料型態改成附圖這樣
一樣能夠跑出我想要的資料嗎

Xl0000040.rar (27.6 KB)

帖子: 192
主題: 15
精華: 0
積分: 194
點名: 0
作業系統: windows
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2016-9-22
最後登錄: 2020-8-28

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

6^#

發表於 2016-10-7 00:32 | 只看該作者

回復 2# 准提部林

不好意思想再修正一下

如果資料型態改成工作表2

一樣想跑出工作表1的樣子呢

[attach]

Xl0000040.rar (27.6 KB)

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

5^#

發表於 2016-10-6 11:34 | 只看該作者

回復 1# starbox520
樞紐分析表細部調整後也能達成

Sub test()
Dim rngData As Range: Set rngData = Sheets("工作表1").Range("A1:E33")
Dim arKeyFields: arKeyFields = Array("CR", "LN", "PG", "BE")
Dim sumField: sumField = "QQ"
Dim pvt As PivotTable, i, x
With Sheets.Add
Set pvt = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rngData, _
Version:=xlPivotTableVersion14 _
).CreatePivotTable(TableDestination:=.[A1])
End With
With pvt
.InGridDropZones = False
.ShowDrillIndicators = False
.DisplayFieldCaptions = True
.RowGrand = False
.ColumnGrand = False
.RowAxisLayout xlTabularRow
i = 1
For Each x In arKeyFields
.PivotFields(x).Orientation = xlRowField
.PivotFields(x).RepeatLabels = True
.PivotFields(x).Subtotals(1) = False
.PivotFields(x).Position = i
Next
.AddDataField .PivotFields(sumField), "加總 - " & sumField, xlSum
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

帖子: 192
主題: 15
精華: 0
積分: 194
點名: 0
作業系統: windows
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2016-9-22
最後登錄: 2020-8-28

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

4^#

發表於 2016-10-5 22:39 | 只看該作者

回復 2# 准提部林

回版大
對耶這是我想要的結果
可以再麻煩版大解說一下程式碼的部分嗎
我想讓自己去嘗試做變動

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

3^#

發表於 2016-10-5 21:00 | 只看該作者

Sub TEST()
Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
Arr = Range([A1], Cells(Rows.Count, 1).End(xlUp)(1, 5))
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
　　For j = 1 To 4: T = T & "/" & Arr(i, j): Next
　　　　Dn = xD(T)
　　　　If Dn = 0 Then
　　　　　N = N + 1: Dn = N: xD(T) = N
　　　　　For j = 1 To 4: Brr(Dn, j) = Arr(i, j): Next
　　　　End If
　　　　Brr(Dn, 5) = Brr(Dn, 5) + Val(Arr(i, 5)): T = ""
Next i
If N > 0 Then [H2].Resize(N, 5) = Brr
End Sub

Xl0000035.rar (16.73 KB)
　