teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

3

ソース修正

2020/04/02 01:09

投稿

yureighost
yureighost

スコア2183

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.Save
64
+ ThisWorkbook.Worksheets("ピボットテーブル").Sort.SortFields.Clear
64
65
 
65
66
  'ユーザー設定リストを削除
66
67
  Application.DeleteCustomList ocNum

2

ソース修正

2020/04/02 01:09

投稿

yureighost
yureighost

スコア2183

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

ソース修正

2020/04/01 06:42

投稿

yureighost
yureighost

スコア2183

answer CHANGED
@@ -6,15 +6,14 @@
6
6
  ゴミが残るのを防止するためソート後に削除しています。
7
7
  ```vba
8
8
  Sub CommandButton3_Click()
9
- Dim DataS As Worksheet
9
+
10
- Dim ws As Worksheet
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)