回答編集履歴
3
ソース修正
answer
CHANGED
@@ -37,9 +37,10 @@
|
|
37
37
|
```
|
38
38
|
|
39
39
|
**追記**
|
40
|
-
書いてしまってからなんですが少し不安定な方法のようです。
|
40
|
+
~~書いてしまってからなんですが少し不安定な方法のようです。
|
41
41
|
ユーザー設定リストを削除する前にブックを保存しておくと落ちるのは防げます。
|
42
|
-
ただソートする時に保存されてしまうのでそこの動作に関してはご了承ください。
|
42
|
+
ただソートする時に保存されてしまうのでそこの動作に関してはご了承ください。~~
|
43
|
+
end-u様の教えてくださった方法でブック保存時の不具合の問題は解決しました。
|
43
44
|
```VBA
|
44
45
|
Application.DisplayAlerts = False
|
45
46
|
|
@@ -59,8 +60,8 @@
|
|
59
60
|
ThisWorkbook.Worksheets("ピボットテーブル").Range("$B$4").Sort Order1:=xlAscending, Type:=xlSortLabels, _
|
60
61
|
OrderCustom:=ocNum + 1, Orientation:=xlLeftToRight, SortMethod:=xlStroke
|
61
62
|
|
62
|
-
'
|
63
|
+
'ピボットテーブルに設定されているソート条件のクリア
|
63
|
-
ThisWorkbook.
|
64
|
+
ThisWorkbook.Worksheets("ピボットテーブル").Sort.SortFields.Clear
|
64
65
|
|
65
66
|
'ユーザー設定リストを削除
|
66
67
|
Application.DeleteCustomList ocNum
|
2
ソース修正
answer
CHANGED
@@ -34,4 +34,36 @@
|
|
34
34
|
Application.DeleteCustomList ListNum:=ocNum
|
35
35
|
|
36
36
|
End Sub
|
37
|
+
```
|
38
|
+
|
39
|
+
**追記**
|
40
|
+
書いてしまってからなんですが少し不安定な方法のようです。
|
41
|
+
ユーザー設定リストを削除する前にブックを保存しておくと落ちるのは防げます。
|
42
|
+
ただソートする時に保存されてしまうのでそこの動作に関してはご了承ください。
|
43
|
+
```VBA
|
44
|
+
Application.DisplayAlerts = False
|
45
|
+
|
46
|
+
With ThisWorkbook.Worksheets("予定表")
|
47
|
+
pEndColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
|
48
|
+
'予定2行目の氏名順をリストで取得する
|
49
|
+
SortData = .Range(.Cells(2, 2), .Cells(2, pEndColumn))
|
50
|
+
End With
|
51
|
+
|
52
|
+
'取得したリストをユーザー設定リストに登録
|
53
|
+
Application.AddCustomList ListArray:=SortData
|
54
|
+
|
55
|
+
'ユーザー設定リスト登録位置を取得
|
56
|
+
ocNum = Application.GetCustomListNum(SortData)
|
57
|
+
|
58
|
+
'登録したユーザー設定リストでピボットテーブルをソート
|
59
|
+
ThisWorkbook.Worksheets("ピボットテーブル").Range("$B$4").Sort Order1:=xlAscending, Type:=xlSortLabels, _
|
60
|
+
OrderCustom:=ocNum + 1, Orientation:=xlLeftToRight, SortMethod:=xlStroke
|
61
|
+
|
62
|
+
'ユーザー設定リストを削除前にブックを保存
|
63
|
+
ThisWorkbook.Save
|
64
|
+
|
65
|
+
'ユーザー設定リストを削除
|
66
|
+
Application.DeleteCustomList ocNum
|
67
|
+
|
68
|
+
Application.DisplayAlerts = True
|
37
69
|
```
|
1
ソース修正
answer
CHANGED
@@ -6,15 +6,14 @@
|
|
6
6
|
ゴミが残るのを防止するためソート後に削除しています。
|
7
7
|
```vba
|
8
8
|
Sub CommandButton3_Click()
|
9
|
-
|
9
|
+
|
10
|
-
|
10
|
+
・・・
|
11
|
-
Dim pvc As PivotCache
|
12
|
-
Dim pvt As PivotTable
|
13
|
-
Dim dEndRow As Long
|
14
11
|
Dim pEndColumn As Long
|
15
|
-
Dim ocNum As Long
|
16
12
|
Dim SortData As Variant
|
13
|
+
・・・
|
17
14
|
|
15
|
+
pvt.AddDataField pvt.PivotFields("執務時間"), "合計 / 執務時間", xlSum
|
16
|
+
|
18
17
|
With ThisWorkbook.Worksheets("予定表")
|
19
18
|
pEndColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
|
20
19
|
'予定2行目の氏名順をリストで取得する
|
@@ -23,40 +22,6 @@
|
|
23
22
|
|
24
23
|
'取得したリストをユーザー設定リストに登録
|
25
24
|
Application.AddCustomList ListArray:=SortData
|
26
|
-
|
27
|
-
Set ws = Sheets.Add
|
28
|
-
ActiveSheet.Name = "ピボットテーブル"
|
29
|
-
Set DataS = ThisWorkbook.Worksheets("日報")
|
30
|
-
|
31
|
-
dEndRow = DataS.Cells(DataS.Rows.Count, 2).End(xlUp).Row
|
32
|
-
Set pvc = ActiveWorkbook.PivotCaches.Create( _
|
33
|
-
SourceType:=xlDatabase, _
|
34
|
-
SourceData:=DataS.Range("A1:K" & dEndRow), _
|
35
|
-
Version:=xlPivotTableVersion15)
|
36
|
-
|
37
|
-
Set pvt = pvc.CreatePivotTable( _
|
38
|
-
TableDestination:=ws.Name & "!R3C1", _
|
39
|
-
TableName:="ピボットテーブル1", _
|
40
|
-
DefaultVersion:=xlPivotTableVersion15)
|
41
|
-
|
42
|
-
With pvt.PivotFields("略号")
|
43
|
-
.Orientation = xlRowField
|
44
|
-
.Position = 1
|
45
|
-
End With
|
46
|
-
|
47
|
-
|
48
|
-
With pvt.PivotFields("日付")
|
49
|
-
.Orientation = xlRowField
|
50
|
-
.Position = 2
|
51
|
-
End With
|
52
|
-
|
53
|
-
|
54
|
-
With pvt.PivotFields("氏名")
|
55
|
-
.Orientation = xlColumnField
|
56
|
-
.Position = 1
|
57
|
-
End With
|
58
|
-
|
59
|
-
pvt.AddDataField pvt.PivotFields("執務時間"), "合計 / 執務時間", xlSum
|
60
25
|
|
61
26
|
'ユーザー設定リスト登録位置を取得
|
62
27
|
ocNum = Application.GetCustomListNum(SortData)
|