またまた エクセルのユーザー定義で

前回以下のようなコードを教えていただきましたが、この変換を複数列で使えるようにするにはどうしたらいいのでしょうか？
D,G,N,Q,X,AA,の列に効かせたいのですが。

Private Sub worksheet_change(ByVal Target As Range)
If Intersect(Target, Columns(1)) Is Nothing Or Selection.Count <> 1 Then Exit Sub
Dim str As String
str = Target
Application.EnableEvents = False
If Target <> "" Then
If Len(str) = 7 Then
Target = Left(str, 5) & "A" & Mid(str, 6, 1) & "-" & Right(str, 1)
Else
Target = Left(str, 5) & "A" & Mid(str, 6, 2) & "-" & Right(str, 1)
End If
End If
Application.EnableEvents = True
End Sub

No.5 ベストアンサー 回答者： cj_mover 回答日時： 2012/10/21 17:26

こんにちは。

お邪魔します。

まず、
http://oshiete.goo.ne.jp/qa/7601020.html
http://oshiete.goo.ne.jp/qa/7743169.html
という一連の流れでいうと、
最初の質問が解決した段階で、本来"ユーザー定義"の表示形式の課題ではなかったと思います。
今回のご質問までくると、対象セルの表示形式は、"文字列"のほうが良いということになります。
（まだしも表示形式："標準"）
覚えのない変更で煩わされる日が来ることの無いよう、一旦、変更済の表示形式を
適宜統一しておいた方がよいかと思います。
その際、表示形式変更後に、対象セルを目視で選択→F2キー→Enterキーのようにひとつずつ直す必要があります。
ただ、
もしも、条件として、
文字列の長さが７～８のセルだけを対象として限定できるならば、より簡単に処理できます。
また、コードそのものの信頼性を高めることが出来ます。
フォーマット前の文字列の長さが７～８という条件に合うなら、
フォーマット済の文字列は必ず９文字以上の長さになりますから、下のコードの
　　　　If nLen >= 7 Then
を
　　　　If nLen >= 7 And nLen <= 8 Then
または
　　　　If nLen > 6 And nLen < 9 Then
という具合に換えてみてください。
全セルを丸ごとコピーして、そのまま丸ごと貼りつけても、必要なセルだけをフォーマットします。

余計な心配でしょうけれど、今後の運用を考えた時に
　　　　If nLen >= 7 Then
など、処理を限定する記述に注意を払わないと、
もしも、"123456"のように６桁の数字だった時とかに
もしも、フォーマットの指定文字が"A"の代わりに"D"や"E"を使うような変更があったりすると
文字列ではなく、指数になってしまいますから、注意して運用してください。

その他、
セルの消去、結合セルの有無、複数領域の値変更、など、一通り、確認済です。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim tmp As Variant
　　Dim r As Range
　　Dim nLen As Long
　　Application.EnableEvents = False
　　On Error Resume Next　　　　　　　　' ' 運用に合わせて適宜指定　↓
　　For Each r In Application.Intersect(Target, Range("A:A,D:D,G:G,N:N,Q:Q,X:X,AA:AA"))
　　　　tmp = r.Value
　　　　nLen = Len(tmp)
　　　　If nLen >= 7 Then r.Value = Left(tmp, 5) & "A" & Mid(tmp, 6, nLen - 6) & "-" & Right(tmp, 1)
　　Next r
　　On Error GoTo 0
　　Application.EnableEvents = True
End Sub

ご質問に関しては以上です。
　
　
Re:other
///
Selection の使い方がおかしいです。Target なのでは？
///
イベントプロシージャとか名前付き引数とかに限っては
大文字小文字を区別して書くようにしませんか？

この回答へのお礼

ご回答ありがとうございます。
確かに題名のユーザー定義云々は中身と違ってきてしまっていましたね。
前回のつながりで同じ題名を引きずってしまいました。
難しいことは分からず、コピペして、何となく出来てしまえばいいといった考えでしたが、
このように応用していく必要が出てくるといろいろ勉強にもなります。
これからもお世話になるかと思いますが、その節はまた宜しくお願いいたします。

お礼日時：2012/10/22 21:52

No.4 回答者： tom04 回答日時： 2012/10/21 13:00

続けてお邪魔します。

一つ気になるコトがあるのですが・・・

※　確認です　※
お示しのコードはA列が対象列なので、
「A」を表示する！
という意味なのでしょうか？

そうであれば今回の質問だと対象列の列番号、
仮にG列であれば　「A」の部分を「G」と表示するという解釈になります。
その場合はコードも変わってきます。

ちょっと気になったので、お邪魔してしまいました。m(_ _)m

この回答へのお礼

いいえ、A列だからAというのではありません。
横に並べたページの表の同じ列に、同じことをしたいということでした。
ありがとうございます。

お礼日時：2012/10/22 21:43

No.3 回答者： tom04 回答日時： 2012/10/21 00:56

No.2です！

投降後に気づきました。
前回はQ列が抜けていました。
すでにお判りだと思いますが、Q列を追加して

If Intersect(Target, Range("D:D,G:G,N:N,Q:Q,X:X,AA:AA")) Is Nothing Or _
Selection.Count <> 1 Then Exit Sub

に訂正してください。

何度も失礼しました。m(_ _)m

この回答へのお礼

ご丁寧にありがとうございます。

お礼日時：2012/10/22 21:38

No.2 回答者： tom04 回答日時： 2012/10/21 00:46

こんばんは！

＞If Intersect(Target, Columns(1)) Is Nothing Or Selection.Count <> 1 Then Exit Sub

の部分を

If Intersect(Target, Range("D:D,G:G,N:N,X:X,AA:AA")) Is Nothing Or _
Selection.Count <> 1 Then Exit Sub

に変更してみてください。
今回のように対象範囲が飛び飛びの場合は、カンマで指定範囲を区切れば対応できます。

尚、余計なお世話かもしれませんが、仮に列が続いている場合は
Range ("B:C,E:F")　←B列・C列とE・F列の場合

のような感じになります。m(_ _)m

この回答へのお礼

ありがとうございます。ネットでいろいろ調べて最初にこんな感じでやってみて出来なかったとおもったのですが、
マクロを有効にしないで試していたのかもしれません。またやってみたら出来ました。
ありがとうございました

お礼日時：2012/10/22 21:37

No.1 回答者： KURUMITO 回答日時： 2012/10/17 14:29

次のようにすればよいでしょう。

A列も加わった条件で書いています。
Private Sub worksheet_change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 7 Or Target.Column = 14 Or Target.Column = 17 Or Target.Column = 24 Or Target.Column = 27 Then
Dim str As String
str = Target
Application.EnableEvents = False
If Target <> "" Then
If Len(str) = 7 Then
Target = Left(str, 5) & "A" & Mid(str, 6, 1) & "-" & Right(str, 1)
Else
Target = Left(str, 5) & "A" & Mid(str, 6, 2) & "-" & Right(str, 1)
End If
End If
End If
Application.EnableEvents = True
End Sub

この回答への補足

ご回答ありがとうございます。
入力して変換は出来るのですがDeieteした時に「実行時エラー13　型が一致しません」と出てしまいます。何か対処法はありますか？

補足日時：2012/10/17 16:05