回答編集履歴
2
追記
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
|
31
|
+
Sub test()
|
18
32
|
|
19
|
-
|
33
|
+
ThisWorkbook.Worksheets(1).Copy
|
20
34
|
|
21
|
-
|
35
|
+
With Workbooks(Workbooks.Count)
|
22
36
|
|
23
|
-
W
|
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
修正
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
|
-
|
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
|
+
改善がみられるでしょうか?
|