都道府県穴埋めゲーム

タイトルのほかにも条件があるのですが、Excel2010で、表示結果に条件があります。
既存に入力されているものなんですが、条件は以下の通りです。

条件1:漢字あるいは、ひらがなはそのまま
条件2:全角カタカナは全角カタカナ
条件3:半角カタカナは全角カタカナ
条件4:全角英数字は半角英数字
条件5:半角英数字は半角英数字
条件6:全角スペースは全角スペース
条件7:半角スペースは全角スペース
条件8:スペースが連続している場合は全角スペース1つのみ

例としては(左側が既存、右側が表示結果)、
全角あいうえお→全角あいうえお
全角アイウエオ→全角アイウエオ
半角アイウエオ→半角アイウエオ
全角110→全角110
半角アイウエオ全角110→半角アイウエオ全角110
半角アイウエオ□全角110→半角アイウエオ□全角110
半角アイウエオ□□全角110→半角アイウエオ□全角110
半角アイウエオ△□全角110→半角アイウエオ□全角110
半角アイウエオ△全角110→半角アイウエオ□全角110
半角アイウエオ△△全角110→半角アイウエオ□全角110
半角アイウエオ△△△全角110→半角アイウエオ□全角110

※「□」は全角スペース、「△」は半角スペースです。分かりやすいように表記してみました。「□」または「△」が複数ある場合、スペースの個数です。

既存の入力されている列は「AE列」です。関数を入力できるのは「AR列」以降です。

関数について詳しくないため、あまり長いお礼はできませんが、回答よろしくお願いします。

A 回答 (3件)

期待通りに動いてくれると良いのですが、


自前の関数を作成します。
下記の
Function myConv(ByVal myArg As String) As String
~中略~
End Function
までをコピーします。

Excelに戻って、Alt + F11 を押してVBEの画面にします。
Alt + i を押して、プルダウンから標準モジュールを選択します。
新たなウィンドウが出ますのでそこへ先ほどのコピーをペーストします。
Alt + F11 を押してExcelに戻ります。
AR列で =myconv(AE1)
等とすれば結果が返ります。

条件1~8と例として挙げられているのが矛盾しているようです。
条件の方で作成しています。


Function myConv(ByVal myArg As String) As String
Dim myReg As Object, myMC As Object, myM As Object

Set myReg = CreateObject("VBScript.RegExp")
'スペースを全角一個だけに
myConv = Replace(myArg, " ", " ", compare:=vbTextCompare)
With myReg
.Pattern = " +"
.Global = True
End With
myConv = myReg.Replace(myConv, " ")

'半角カタカナは全角カタカナ
With myReg
.Pattern = "[\uff66-\uff9f]+"
.Global = True
Set myMC = .Execute(myConv)
End With

For Each myM In myMC
myConv = Replace(myConv, myM.Value, StrConv(myM.Value, vbWide), compare:=vbTextCompare)
Next

'全角英数字は半角英数字
With myReg
.Pattern = "[0-9A-Za-z]+"
.Global = True
Set myMC = .Execute(myConv)
End With

For Each myM In myMC
myConv = Replace(myConv, myM.Value, StrConv(myM.Value, vbNarrow), compare:=vbTextCompare)
Next

Set myMC = Nothing: Set myReg = Nothing
End Function
    • good
    • 0
この回答へのお礼

回答ありがとうございます。

前者の通りVBAのことはほとんど分かりません。
なので、そのままコピーさせて試してみます。

あと、また関数ではなくVBAで新たに質問するかもしれませんがその時はよろしくお願いします。

ありがとうございました。

お礼日時:2013/02/12 03:57

こんばんは。



関数に詳しくないとかなら、Wordで処理する方法もありかとは思います。
Wordの置換のワイルドカードを使います。

それが面倒なら、以下をVBEditor に貼り付けて一発変換という方法もあります。
正規表現を利用していますから、VBAでの処理が嫌なら、テキストエディタでも可能です。
数回の処理にはなるかと思いますが、基本的には、全角数字とスペースの統一です。

'//
Sub RegExpExchange()
 Dim myRange As Range
 Dim objReg As Object
 Dim Matches As Object
 Dim Match As Variant
 Dim c As Range
 Dim Dspc As String
 Dspc = Chr(&H8140) '一般的な全角スペース
 Application.ScreenUpdating = False
 With ActiveSheet
  'データはA列にあるとする
  Set myRange = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
 End With
 Set objReg = CreateObject("VBScript.RegExp")
 With objReg
  For Each c In myRange
   buf = c.Value
   .Pattern = "[0-9]+"
   .Global = True
   If .Test(buf) Then
    Set Matches = .Execute(buf)
    For Each Match In Matches
     buf = Replace(buf, Match, StrConv(Match, vbNarrow))
    Next Match
   End If
   .Pattern = "[" & Dspc & Space(1) & "]+" '全角・半角スペース1つずつ入れる
   .Global = True
   If .Test(buf) Then
    Set Matches = .Execute(buf)
    For Each Match In Matches
     buf = Replace(buf, Match, Dspc)
    Next Match
   End If
   c.Offset(, 1).Value = buf
  Next c
 End With
 Application.ScreenUpdating = True
 Set objReg = Nothing
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。

VBAですか。
VBAのことはちんぷんかんぷんなので、どのような処理をしているのか分かりません。
なので、どうお礼をしたらいいのか分かりませんがとりあえずありがとうございました。

お礼日時:2013/02/12 03:52

簡単にはできませんね。



マクロを使用しないのであれば…
全角の英数字とカタカナを半角文字にする場合はASC関数、その逆はJIS関数を使います。
カタカナは全角という縛りがありますので、とりあえず全角に変換した後
英数字をひとつずつ置換で置き換えるくらいしか思いつきません。
    • good
    • 0
この回答へのお礼

回答ありがとうございます。

やはり難しいですか。
自分としましてもASC関数、JIS関数は知っていますが、すべて条件を満たすような条件は厳しいですね。

ありがとうございました。

お礼日時:2013/02/12 03:46

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報