回答編集履歴

2

追記

2020/02/08 11:55

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -1,56 +1,84 @@
1
- > 動作遅く使物にせん
1
+ 意図伝わっようので、全部書き直し
2
2
 
3
3
 
4
4
 
5
- 何件くらいタ数で、何秒くらい掛かってます?
5
+ 新規ブック一番左のシトに以下をコピペ
6
6
 
7
+
7
8
 
9
+ ```ここに言語を入力
8
10
 
9
- 数式の部分が見えませんが、
11
+ URL PV
10
12
 
11
- こんな感じだといかがでしょう?
13
+ /topics/2019/ 100
12
14
 
15
+ /topics/2019/?f2019ml* 10
13
16
 
17
+ /topics/2019/?form*side_banner 1
18
+
19
+ /interview/2020/ 200
20
+
21
+ /interview/2020/?f2019ml* 20
22
+
23
+ /interview/2020/?form*side_banner 2
24
+
25
+ ```
26
+
27
+ コードは、
14
28
 
15
29
  ```ExcelVBA
16
30
 
17
- Sub Macro3()
31
+ Sub test()
18
32
 
19
- With Worksheets("重複削除")
33
+ ThisWorkbook.Worksheets(1).Copy
20
34
 
21
- .Columns("B:B").Insert
35
+ With Workbooks(Workbooks.Count)
22
36
 
23
- With .UsedRange
37
+ .Worksheets.Add after:=.Worksheets(1)
24
38
 
39
+ With .Worksheets(1)
40
+
41
+ .Activate '←動作確認用(本番では不要)
42
+
43
+ .Columns("B").Insert
44
+
25
- .Columns("A").TextToColumns OtherChar:="?"
45
+ .Columns("A").TextToColumns Destination:=Range("A1"), OtherChar:="?"
26
46
 
27
47
  Application.DisplayAlerts = False
28
48
 
29
- .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
49
+ .Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
50
+
51
+ Application.DisplayAlerts = True
52
+
53
+ .Outline.ShowLevels RowLevels:=2
54
+
55
+ With .UsedRange
56
+
57
+ .Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
58
+
59
+ End With
60
+
61
+ With .Next
62
+
63
+ .Activate '←動作確認用
64
+
65
+ .Paste Destination:=.Range("A1")
66
+
67
+ .Columns("A").Replace What:=" 集計", Replacement:=""
68
+
69
+ .Columns("B").Delete
70
+
71
+ .UsedRange.EntireColumn.AutoFit
72
+
73
+ End With
74
+
75
+ Application.DisplayAlerts = False
76
+
77
+ .Delete
30
78
 
31
79
  Application.DisplayAlerts = True
32
80
 
33
81
  End With
34
-
35
- .Outline.ShowLevels RowLevels:=2
36
-
37
- With .UsedRange
38
-
39
- .Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
40
-
41
- End With
42
-
43
- End With
44
-
45
-
46
-
47
- With Sheets("結果ページ")
48
-
49
- .Range("A1").PasteSpecial Paste:=xlPasteValues
50
-
51
- .UsedRange.Columns("A").Replace What:=" 集計", Replacement:=""
52
-
53
- .Columns("B").Delete
54
82
 
55
83
  End With
56
84
 
@@ -58,4 +86,26 @@
58
86
 
59
87
  ```
60
88
 
89
+
90
+
91
+ ※基本的に手動での操作を自動で行うように書いているだけだから、
92
+
61
- 改善がみられるでしょうか?
93
+ 手動でも1~2分くいあば出来んじゃないでしょうか?
94
+
95
+ 手動だと複雑な手順だと、手順を間違えることがあるのでマクロ化(作業の自動化)を
96
+
97
+ したいところですね^^
98
+
99
+
100
+
101
+ 命令とかいちいち覚えてないので、
102
+
103
+ マクロの記録である程度コードを探って、
104
+
105
+ ヘルプで省略していい引数(無駄なことも記録される)や引数に何を入れたらいいか、
106
+
107
+ いろいろ確認して、
108
+
109
+ あとはコツとか不都合がある部分はネットを調べて、
110
+
111
+ プラス経験で完成させる感じです。(とにかく何度でも書いて動かしてみる。)

1

修正

2020/02/08 11:55

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -24,11 +24,19 @@
24
24
 
25
25
  .Columns("A").TextToColumns OtherChar:="?"
26
26
 
27
+ Application.DisplayAlerts = False
28
+
27
29
  .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
28
30
 
29
- .Outline.ShowLevels RowLevels:=2
31
+ Application.DisplayAlerts = True
30
32
 
33
+ End With
34
+
35
+ .Outline.ShowLevels RowLevels:=2
36
+
37
+ With .UsedRange
38
+
31
- .SpecialCells(xlCellTypeVisible).Copy
39
+ .Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
32
40
 
33
41
  End With
34
42
 
@@ -49,3 +57,5 @@
49
57
  End Sub
50
58
 
51
59
  ```
60
+
61
+ 改善がみられるでしょうか?