。
|
|
|
|
コメント(32)
たいらさんが関数作成してくださるとコメントされていますが
手が空いたのでたいらさんに恐縮ですが代わりに書いてみました。
頻繁に使用するのであれば「個人用マクロブック」に保存し、
以下の「ユーザー定義関数」を使用して変換された文字列を
コピー＆値貼り付けして入稿するような運用にすると良いかもしれませんね。
ちなみに
> 確認ですが「数字1桁」は全角に変換するのですか？
は>>1の要件に書いてないので考慮していません。
'「VBE」で「標準モジュール」を挿入して、そこに記載
Option Explicit
Public Function f_全角2桁以上数値to半角数値(ByVal strArg As String) As String
Const REG_FORMAT As String = "[０-９]{2,}"
Dim lngList() As Long
Dim objRegExp As Object
Dim objRegMc As Object
Dim objRegMt As Object
Dim i As Long
Dim j As Long
Dim lngTmp As Long
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True
objRegExp.Pattern = REG_FORMAT
Set objRegMc = objRegExp.Execute(strArg)
If objRegMc.Count = 0 Then
f_全角2桁以上数値to半角数値 = strArg
Exit Function
End If
ReDim Preserve lngList(objRegMc.Count - 1)
For Each objRegMt In objRegMc
lngList(i) = StrConv(objRegMt.Value, vbNarrow)
i = i + 1
Next
Set objRegMt = Nothing
Set objRegMc = Nothing
Set objRegExp = Nothing
For i = LBound(lngList) To UBound(lngList) - 1
For j = LBound(lngList) To LBound(lngList) + UBound(lngList) - i - 1
If lngList(j + 1) > lngList(j) Then
lngTmp = lngList(j)
lngList(j) = lngList(j + 1)
lngList(j + 1) = lngTmp
End If
Next j
Next i
For i = 0 To UBound(lngList) Step 1
strArg = Replace$(strArg, StrConv(lngList(i), vbWide), lngList(i))
Next i
Erase lngList
f_全角2桁以上数値to半角数値 = strArg
End Function
関数の使い方は画像参照。
個人用マクロブックを使用する場合なども含めて、
「ユーザー定義関数」は「関数ダイアログ」からの使用が楽です。
わからない用語などありましたらカッコ内の用語 + excel などでググって調べてみてください。
ご参考までに。
もうちょっとシンプルなロジックにしたかったけど・・・ならなかったな・・・（独り言）
手が空いたのでたいらさんに恐縮ですが代わりに書いてみました。
頻繁に使用するのであれば「個人用マクロブック」に保存し、
以下の「ユーザー定義関数」を使用して変換された文字列を
コピー＆値貼り付けして入稿するような運用にすると良いかもしれませんね。
ちなみに
> 確認ですが「数字1桁」は全角に変換するのですか？
は>>1の要件に書いてないので考慮していません。
'「VBE」で「標準モジュール」を挿入して、そこに記載
Option Explicit
Public Function f_全角2桁以上数値to半角数値(ByVal strArg As String) As String
Const REG_FORMAT As String = "[０-９]{2,}"
Dim lngList() As Long
Dim objRegExp As Object
Dim objRegMc As Object
Dim objRegMt As Object
Dim i As Long
Dim j As Long
Dim lngTmp As Long
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True
objRegExp.Pattern = REG_FORMAT
Set objRegMc = objRegExp.Execute(strArg)
If objRegMc.Count = 0 Then
f_全角2桁以上数値to半角数値 = strArg
Exit Function
End If
ReDim Preserve lngList(objRegMc.Count - 1)
For Each objRegMt In objRegMc
lngList(i) = StrConv(objRegMt.Value, vbNarrow)
i = i + 1
Next
Set objRegMt = Nothing
Set objRegMc = Nothing
Set objRegExp = Nothing
For i = LBound(lngList) To UBound(lngList) - 1
For j = LBound(lngList) To LBound(lngList) + UBound(lngList) - i - 1
If lngList(j + 1) > lngList(j) Then
lngTmp = lngList(j)
lngList(j) = lngList(j + 1)
lngList(j + 1) = lngTmp
End If
Next j
Next i
For i = 0 To UBound(lngList) Step 1
strArg = Replace$(strArg, StrConv(lngList(i), vbWide), lngList(i))
Next i
Erase lngList
f_全角2桁以上数値to半角数値 = strArg
End Function
関数の使い方は画像参照。
個人用マクロブックを使用する場合なども含めて、
「ユーザー定義関数」は「関数ダイアログ」からの使用が楽です。
わからない用語などありましたらカッコ内の用語 + excel などでググって調べてみてください。
ご参考までに。
もうちょっとシンプルなロジックにしたかったけど・・・ならなかったな・・・（独り言）
まだ実験途中ですので、上手くいくか分かりませんが
こんな感じでも出来るかもしれません
参考までに・・・
Function 全角2桁以上数値半角変換(str As String) As String
For i = 1 To Len(str)
If IsNumeric(Mid(str, i, 2)) Then
For j = 2 To Len(str) - i + 1
If IsNumeric(Mid(str, i, j)) = False Or StrConv(Mid(str, i + j - 1, 1), 8) = " " Then Exit For
Next j
j = j - 1
Nstr = Nstr & StrConv(Mid(str, i, j), 8)
i = i + (j - 1)
Else
Nstr = Nstr & Mid(str, i, 1)
End If
Next i
全角2桁以上数値半角変換 = Nstr
End Function
こんな感じでも出来るかもしれません
参考までに・・・
Function 全角2桁以上数値半角変換(str As String) As String
For i = 1 To Len(str)
If IsNumeric(Mid(str, i, 2)) Then
For j = 2 To Len(str) - i + 1
If IsNumeric(Mid(str, i, j)) = False Or StrConv(Mid(str, i + j - 1, 1), 8) = " " Then Exit For
Next j
j = j - 1
Nstr = Nstr & StrConv(Mid(str, i, j), 8)
i = i + (j - 1)
Else
Nstr = Nstr & Mid(str, i, 1)
End If
Next i
全角2桁以上数値半角変換 = Nstr
End Function
よっちゃんさん
お手数をお掛けします。
よっちゃんさんのユーザ関数名やマッチングパターンをそのまま利用させて頂きました。
注）
※VBScript.RegExp参照設定をした方がプログラムは作りやすいかも知れません。
※必要なら数字１桁を全角にする、半角全角混在の対応する等々も必要かも？
Public Function f_全角2桁以上数値to半角数値(ByVal strArg As String) As String
Dim I As Integer
Dim oRe As Object
Dim oMatches As Object
Set oRe = CreateObject("VBScript.RegExp")
oRe.Global = True
oRe.Pattern = "([０-９]{2,})"
Set oMatches = oRe.Execute(strArg)
For I = 0 To oMatches.Count - 1
strArg = Replace(strArg, oMatches(I), StrConv(oMatches(I), vbNarrow))
Next I
f_全角2桁以上数値to半角数値 = strArg
Set oRe = Nothing
Set oMatches = Nothing
End Function
お手数をお掛けします。
よっちゃんさんのユーザ関数名やマッチングパターンをそのまま利用させて頂きました。
注）
※VBScript.RegExp参照設定をした方がプログラムは作りやすいかも知れません。
※必要なら数字１桁を全角にする、半角全角混在の対応する等々も必要かも？
Public Function f_全角2桁以上数値to半角数値(ByVal strArg As String) As String
Dim I As Integer
Dim oRe As Object
Dim oMatches As Object
Set oRe = CreateObject("VBScript.RegExp")
oRe.Global = True
oRe.Pattern = "([０-９]{2,})"
Set oMatches = oRe.Execute(strArg)
For I = 0 To oMatches.Count - 1
strArg = Replace(strArg, oMatches(I), StrConv(oMatches(I), vbNarrow))
Next I
f_全角2桁以上数値to半角数値 = strArg
Set oRe = Nothing
Set oMatches = Nothing
End Function
たいらさん
> VBScript.RegExp参照設定をした方がプログラムは作りやすいかも知れません
コーディングはしやすいでしょうね。
私は掲示板などでの回答は参照設定を促すことはほとんどありません。
コードをコピペでそのまま使えるようにするため、
Early BindではなくLate Bindでコード提示するようにしています。
もちろん質問者がEarly Bindのコード提示してきて「わからん」という場合には
回答する際にはそれに合わせたコードにしますがｗ
たいらさんご提示のコードと私のコードの違いは置換の順番ですね。
正規表現でHITした順に処理しているので、HITした前半で
後半に含まれる全角２文字以上の数値があった場合に後半がうまく動かないかと。
「東京都◯◯区◯◯町3ー１５ー２２ エクセルマンション２２５」
↓
「東京都◯◯区◯◯町3ー15ー22 エクセルマンション22５」
マリ男さん
まだ実験途中とのことですが完成はしましたでしょうか。
IsNumericの判定ですと、「２．」などもTrueとなりますね。
そうなると、少しだけ改修する必要がありそうです。
今のままでは全角ピリオドなども半角に変換されてしまいます。
「東京都◯◯区◯◯町3ー１５ー２２ エクセルマンション２．２５」
↓
「東京都◯◯区◯◯町3ー15ー22 エクセルマンション2.25」
とはいえ、とてもシンプルなロジックになりましたね^^
マリ男さんのコードをいじって文字列の置換を
Midステートメントなどで行えは最速・最軽量になりそうな気がします。
> VBScript.RegExp参照設定をした方がプログラムは作りやすいかも知れません
コーディングはしやすいでしょうね。
私は掲示板などでの回答は参照設定を促すことはほとんどありません。
コードをコピペでそのまま使えるようにするため、
Early BindではなくLate Bindでコード提示するようにしています。
もちろん質問者がEarly Bindのコード提示してきて「わからん」という場合には
回答する際にはそれに合わせたコードにしますがｗ
たいらさんご提示のコードと私のコードの違いは置換の順番ですね。
正規表現でHITした順に処理しているので、HITした前半で
後半に含まれる全角２文字以上の数値があった場合に後半がうまく動かないかと。
「東京都◯◯区◯◯町3ー１５ー２２ エクセルマンション２２５」
↓
「東京都◯◯区◯◯町3ー15ー22 エクセルマンション22５」
マリ男さん
まだ実験途中とのことですが完成はしましたでしょうか。
IsNumericの判定ですと、「２．」などもTrueとなりますね。
そうなると、少しだけ改修する必要がありそうです。
今のままでは全角ピリオドなども半角に変換されてしまいます。
「東京都◯◯区◯◯町3ー１５ー２２ エクセルマンション２．２５」
↓
「東京都◯◯区◯◯町3ー15ー22 エクセルマンション2.25」
とはいえ、とてもシンプルなロジックになりましたね^^
マリ男さんのコードをいじって文字列の置換を
Midステートメントなどで行えは最速・最軽量になりそうな気がします。
>22
>IsNumericの判定ですと、「２．」などもTrueとなりますね。
確かにそうですね
かなり無理矢理ですが修正してみました
Function 全角2桁以上数値半角変換(str As String) As String
For i = 1 To Len(str)
If Len(Mid(str, i, 2)) = 2 And IsNumeric(Mid(str, i, 2)) And InStr(StrConv(Mid(str, i, 2), 8), ".") = 0 Then
For j = 2 To Len(str) - i + 1
If IsNumeric(Mid(str, i, j)) = False Or StrConv(Mid(str, i + j - 1, 1), 8) = " " Or InStr(StrConv(Mid(str, i, j), 8), ".") <> 0 Then Exit For
Next j
j = j - 1
Nstr = Nstr & StrConv(Mid(str, i, j), 8)
i = i + (j - 1)
Else
Nstr = Nstr & Mid(str, i, 1)
End If
Next i
全角2桁以上数値半角変換 = Nstr
End Function
>24,25は修正していないコードを貼り付けてしまったので
削除しました、すみません
>IsNumericの判定ですと、「２．」などもTrueとなりますね。
確かにそうですね
かなり無理矢理ですが修正してみました
Function 全角2桁以上数値半角変換(str As String) As String
For i = 1 To Len(str)
If Len(Mid(str, i, 2)) = 2 And IsNumeric(Mid(str, i, 2)) And InStr(StrConv(Mid(str, i, 2), 8), ".") = 0 Then
For j = 2 To Len(str) - i + 1
If IsNumeric(Mid(str, i, j)) = False Or StrConv(Mid(str, i + j - 1, 1), 8) = " " Or InStr(StrConv(Mid(str, i, j), 8), ".") <> 0 Then Exit For
Next j
j = j - 1
Nstr = Nstr & StrConv(Mid(str, i, j), 8)
i = i + (j - 1)
Else
Nstr = Nstr & Mid(str, i, 1)
End If
Next i
全角2桁以上数値半角変換 = Nstr
End Function
>24,25は修正していないコードを貼り付けてしまったので
削除しました、すみません
マクロは初心者だけど、作ってみた。
大量にある場合は、一気に変換できそう。
住所なので、三桁までとしたけど、自由に変更可能。
「半角数字→全角変換」を実行すれば、戻して何度でも試せる。
Sub 二桁以上全角数字→半角変換()
For i = 999 To 10 Step -1
Cells.Replace What:=StrConv(i, 4), Replacement:=i
Next i
End Sub
Sub 半角数字→全角変換()
For i = 0 To 9
Cells.Replace What:=i, Replacement:=StrConv(i, 4)
Next i
End Sub
大量にある場合は、一気に変換できそう。
住所なので、三桁までとしたけど、自由に変更可能。
「半角数字→全角変換」を実行すれば、戻して何度でも試せる。
Sub 二桁以上全角数字→半角変換()
For i = 999 To 10 Step -1
Cells.Replace What:=StrConv(i, 4), Replacement:=i
Next i
End Sub
Sub 半角数字→全角変換()
For i = 0 To 9
Cells.Replace What:=i, Replacement:=StrConv(i, 4)
Next i
End Sub
- mixiユーザー
- ログインしてコメントしよう！
|
|
|
|
