回答編集履歴
2
追記
answer
CHANGED
|
@@ -1,31 +1,56 @@
|
|
|
1
|
-
|
|
1
|
+
意図が伝わって無いようなので、全部書き直します。
|
|
2
2
|
|
|
3
|
-
|
|
3
|
+
新規ブックの一番左のシートに以下をコピペ
|
|
4
|
-
|
|
4
|
+
|
|
5
|
-
|
|
5
|
+
```ここに言語を入力
|
|
6
|
-
|
|
6
|
+
URL PV
|
|
7
|
-
|
|
7
|
+
/topics/2019/ 100
|
|
8
|
+
/topics/2019/?f2019ml* 10
|
|
9
|
+
/topics/2019/?form*side_banner 1
|
|
10
|
+
/interview/2020/ 200
|
|
11
|
+
/interview/2020/?f2019ml* 20
|
|
12
|
+
/interview/2020/?form*side_banner 2
|
|
13
|
+
```
|
|
14
|
+
コードは、
|
|
8
15
|
```ExcelVBA
|
|
9
|
-
Sub
|
|
16
|
+
Sub test()
|
|
17
|
+
ThisWorkbook.Worksheets(1).Copy
|
|
10
|
-
With
|
|
18
|
+
With Workbooks(Workbooks.Count)
|
|
19
|
+
.Worksheets.Add after:=.Worksheets(1)
|
|
20
|
+
With .Worksheets(1)
|
|
21
|
+
.Activate '←動作確認用（本番では不要）
|
|
11
|
-
|
|
22
|
+
.Columns("B").Insert
|
|
12
|
-
With .UsedRange
|
|
13
|
-
.Columns("A").TextToColumns OtherChar:="?"
|
|
23
|
+
.Columns("A").TextToColumns Destination:=Range("A1"), OtherChar:="?"
|
|
14
24
|
Application.DisplayAlerts = False
|
|
15
|
-
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
|
|
25
|
+
.Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
|
|
16
26
|
Application.DisplayAlerts = True
|
|
27
|
+
.Outline.ShowLevels RowLevels:=2
|
|
28
|
+
With .UsedRange
|
|
29
|
+
.Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
|
|
30
|
+
End With
|
|
31
|
+
With .Next
|
|
32
|
+
.Activate '←動作確認用
|
|
33
|
+
.Paste Destination:=.Range("A1")
|
|
34
|
+
.Columns("A").Replace What:=" 集計", Replacement:=""
|
|
35
|
+
.Columns("B").Delete
|
|
36
|
+
.UsedRange.EntireColumn.AutoFit
|
|
37
|
+
End With
|
|
38
|
+
Application.DisplayAlerts = False
|
|
39
|
+
.Delete
|
|
40
|
+
Application.DisplayAlerts = True
|
|
17
41
|
End With
|
|
18
|
-
.Outline.ShowLevels RowLevels:=2
|
|
19
|
-
With .UsedRange
|
|
20
|
-
.Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
|
|
21
|
-
End With
|
|
22
42
|
End With
|
|
23
|
-
|
|
24
|
-
With Sheets("結果ページ")
|
|
25
|
-
.Range("A1").PasteSpecial Paste:=xlPasteValues
|
|
26
|
-
.UsedRange.Columns("A").Replace What:=" 集計", Replacement:=""
|
|
27
|
-
.Columns("B").Delete
|
|
28
|
-
End With
|
|
29
43
|
End Sub
|
|
30
44
|
```
|
|
45
|
+
|
|
46
|
+
※基本的に手動での操作を自動で行うように書いているだけだから、
|
|
31
|
-
|
|
47
|
+
手動でも1～2分くらいあれば出来るんじゃないでしょうか？
|
|
48
|
+
手動だと複雑な手順だと、手順を間違えることがあるのでマクロ化（作業の自動化）を
|
|
49
|
+
したいところですね＾＾
|
|
50
|
+
|
|
51
|
+
命令とかいちいち覚えてないので、
|
|
52
|
+
マクロの記録である程度コードを探って、
|
|
53
|
+
ヘルプで省略していい引数(無駄なことも記録される）や引数に何を入れたらいいか、
|
|
54
|
+
いろいろ確認して、
|
|
55
|
+
あとはコツとか不都合がある部分はネットを調べて、
|
|
56
|
+
プラス経験で完成させる感じです。（とにかく何度でも書いて動かしてみる。）
|
1
修正
answer
CHANGED
|
@@ -11,10 +11,14 @@
|
|
|
11
11
|
.Columns("B:B").Insert
|
|
12
12
|
With .UsedRange
|
|
13
13
|
.Columns("A").TextToColumns OtherChar:="?"
|
|
14
|
+
Application.DisplayAlerts = False
|
|
14
15
|
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=3
|
|
15
|
-
.Outline.ShowLevels RowLevels:=2
|
|
16
|
-
.
|
|
16
|
+
Application.DisplayAlerts = True
|
|
17
17
|
End With
|
|
18
|
+
.Outline.ShowLevels RowLevels:=2
|
|
19
|
+
With .UsedRange
|
|
20
|
+
.Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
|
|
21
|
+
End With
|
|
18
22
|
End With
|
|
19
23
|
|
|
20
24
|
With Sheets("結果ページ")
|
|
@@ -23,4 +27,5 @@
|
|
|
23
27
|
.Columns("B").Delete
|
|
24
28
|
End With
|
|
25
29
|
End Sub
|
|
26
|
-
```
|
|
30
|
+
```
|
|
31
|
+
改善がみられるでしょうか？
|