回答編集履歴
2
追記
answer
CHANGED
|
@@ -29,4 +29,32 @@
|
|
|
29
29
|
Set reg = Nothing
|
|
30
30
|
|
|
31
31
|
End Sub
|
|
32
|
+
```
|
|
33
|
+
追記
|
|
34
|
+
質問クローズ後の修正で申し訳ありません。
|
|
35
|
+
用途は作業の効率化・単純化であってこのコード自体の効率化は関係ないと思いますが、個人的に気になったので少しだけ修正させてください。
|
|
36
|
+
ループは１回で済みそうなので、改良版を載せておきます。
|
|
37
|
+
```VBA
|
|
38
|
+
Sub test()
|
|
39
|
+
Set reg = CreateObject("VBscript.RegExp")
|
|
40
|
+
Set sh = Worksheets("シート名")
|
|
41
|
+
|
|
42
|
+
With reg
|
|
43
|
+
.Pattern = "[\x01-\x7E\xA1-\xDF]"
|
|
44
|
+
.IgnoreCase = False
|
|
45
|
+
.Global = True
|
|
46
|
+
End With
|
|
47
|
+
|
|
48
|
+
For r = 100 To 1 Step -1
|
|
49
|
+
' 全角以外を削除
|
|
50
|
+
sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
|
|
51
|
+
' 空行なら削除
|
|
52
|
+
If sh.Cells(r, 1) = "" Then
|
|
53
|
+
sh.Cells(r, 1).EntireRow.Delete
|
|
54
|
+
End If
|
|
55
|
+
Next
|
|
56
|
+
|
|
57
|
+
Set reg = Nothing
|
|
58
|
+
|
|
59
|
+
End Sub
|
|
32
60
|
```
|
1
シート名を指定する
answer
CHANGED
|
@@ -2,10 +2,12 @@
|
|
|
2
2
|
仮に100行分処理するようにしてあります。
|
|
3
3
|
行数は適宜修正してください。
|
|
4
4
|
各行から全角文字以外を削除後、空行を削除します。
|
|
5
|
+
"シート名"のところも適宜修正してください。
|
|
5
6
|
```VBA
|
|
6
7
|
Sub test()
|
|
7
8
|
Set reg = CreateObject("VBscript.RegExp")
|
|
8
|
-
|
|
9
|
+
Set sh = Worksheets("シート名")
|
|
10
|
+
|
|
9
11
|
With reg
|
|
10
12
|
.Pattern = "[\x01-\x7E\xA1-\xDF]"
|
|
11
13
|
.IgnoreCase = False
|
|
@@ -14,13 +16,13 @@
|
|
|
14
16
|
|
|
15
17
|
' 全角以外を削除
|
|
16
18
|
For r = 1 To 100
|
|
17
|
-
Cells(r, 1) = reg.Replace(Cells(r, 1), "")
|
|
19
|
+
sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
|
|
18
20
|
Next
|
|
19
21
|
|
|
20
22
|
' 空行削除
|
|
21
23
|
For r = 100 To 1 Step -1
|
|
22
|
-
If Cells(r, 1) = "" Then
|
|
24
|
+
If sh.Cells(r, 1) = "" Then
|
|
23
|
-
Cells(r, 1).EntireRow.Delete
|
|
25
|
+
sh.Cells(r, 1).EntireRow.Delete
|
|
24
26
|
End If
|
|
25
27
|
Next
|
|
26
28
|
|