回答編集履歴

2

追記

2018/08/30 07:38

投稿

ttyp03
ttyp03

スコア17000

test CHANGED
@@ -61,3 +61,59 @@
61
61
  End Sub
62
62
 
63
63
  ```
64
+
65
+ 追記
66
+
67
+ 質問クローズ後の修正で申し訳ありません。
68
+
69
+ 用途は作業の効率化・単純化であってこのコード自体の効率化は関係ないと思いますが、個人的に気になったので少しだけ修正させてください。
70
+
71
+ ループは1回で済みそうなので、改良版を載せておきます。
72
+
73
+ ```VBA
74
+
75
+ Sub test()
76
+
77
+ Set reg = CreateObject("VBscript.RegExp")
78
+
79
+ Set sh = Worksheets("シート名")
80
+
81
+
82
+
83
+ With reg
84
+
85
+ .Pattern = "[\x01-\x7E\xA1-\xDF]"
86
+
87
+ .IgnoreCase = False
88
+
89
+ .Global = True
90
+
91
+ End With
92
+
93
+
94
+
95
+ For r = 100 To 1 Step -1
96
+
97
+ ' 全角以外を削除
98
+
99
+ sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
100
+
101
+ ' 空行なら削除
102
+
103
+ If sh.Cells(r, 1) = "" Then
104
+
105
+ sh.Cells(r, 1).EntireRow.Delete
106
+
107
+ End If
108
+
109
+ Next
110
+
111
+
112
+
113
+ Set reg = Nothing
114
+
115
+
116
+
117
+ End Sub
118
+
119
+ ```

1

シート名を指定する

2018/08/30 07:38

投稿

ttyp03
ttyp03

スコア17000

test CHANGED
@@ -6,13 +6,17 @@
6
6
 
7
7
  各行から全角文字以外を削除後、空行を削除します。
8
8
 
9
+ "シート名"のところも適宜修正してください。
10
+
9
11
  ```VBA
10
12
 
11
13
  Sub test()
12
14
 
13
15
  Set reg = CreateObject("VBscript.RegExp")
14
16
 
15
-
17
+ Set sh = Worksheets("シート名")
18
+
19
+
16
20
 
17
21
  With reg
18
22
 
@@ -30,7 +34,7 @@
30
34
 
31
35
  For r = 1 To 100
32
36
 
33
- Cells(r, 1) = reg.Replace(Cells(r, 1), "")
37
+ sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
34
38
 
35
39
  Next
36
40
 
@@ -40,9 +44,9 @@
40
44
 
41
45
  For r = 100 To 1 Step -1
42
46
 
43
- If Cells(r, 1) = "" Then
47
+ If sh.Cells(r, 1) = "" Then
44
48
 
45
- Cells(r, 1).EntireRow.Delete
49
+ sh.Cells(r, 1).EntireRow.Delete
46
50
 
47
51
  End If
48
52