エクセルのユーザー定義で複数列に効かせる方法は?

このQ&Aのポイント
  • エクセルのユーザー定義関数で、特定の列に効かせる方法について教えてください。
  • D、G、N、Q、X、AAの列に効かせる方法を知りたいです。
  • セルの値を変換するコードを複数列で使用する方法を教えてください。
回答を見る
  • ベストアンサー

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

前回以下のようなコードを教えていただきましたが、この変換を複数列で使えるようにするにはどうしたらいいのでしょうか? 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

質問者が選んだベストアンサー

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.5

こんにちは。お邪魔します。 まず、 http://okwave.jp/qa/q7601020.html http://okwave.jp/qa/q7743169.html という一連の流れでいうと、 最初の質問が解決した段階で、本来"ユーザー定義"の表示形式の課題ではなかったと思います。 今回のご質問までくると、対象セルの表示形式は、"文字列"のほうが良いということになります。 (まだしも表示形式:"標準") 覚えのない変更で煩わされる日が来ることの無いよう、一旦、変更済の表示形式を 適宜統一しておいた方がよいかと思います。 その際、表示形式変更後に、対象セルを目視で選択→F2キー→Enterキーのようにひとつずつ直す必要があります。 ただ、 もしも、条件として、 文字列の長さが7~8のセルだけを対象として限定できるならば、より簡単に処理できます。 また、コードそのものの信頼性を高めることが出来ます。 フォーマット前の文字列の長さが7~8という条件に合うなら、 フォーマット済の文字列は必ず9文字以上の長さになりますから、下のコードの     If nLen >= 7 Then を     If nLen >= 7 And nLen <= 8 Then または     If nLen > 6 And nLen < 9 Then という具合に換えてみてください。 全セルを丸ごとコピーして、そのまま丸ごと貼りつけても、必要なセルだけをフォーマットします。 余計な心配でしょうけれど、今後の運用を考えた時に     If nLen >= 7 Then など、処理を限定する記述に注意を払わないと、 もしも、"123456"のように6桁の数字だった時とかに もしも、フォーマットの指定文字が"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 なのでは? /// イベントプロシージャとか名前付き引数とかに限っては 大文字小文字を区別して書くようにしませんか?

yatchky303
質問者

お礼

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

その他の回答 (4)

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.4

続けてお邪魔します。 一つ気になるコトがあるのですが・・・ ※ 確認です ※ お示しのコードはA列が対象列なので、 「A」を表示する! という意味なのでしょうか? そうであれば今回の質問だと対象列の列番号、 仮にG列であれば 「A」の部分を「G」と表示するという解釈になります。 その場合はコードも変わってきます。 ちょっと気になったので、お邪魔してしまいました。m(_ _)m

yatchky303
質問者

お礼

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

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

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

yatchky303
質問者

お礼

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

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.2

こんばんは! >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

yatchky303
質問者

お礼

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

  • KURUMITO
  • ベストアンサー率42% (1835/4283)
回答No.1

次のようにすればよいでしょう。 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

yatchky303
質問者

補足

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

関連するQ&A

  • 続・エクセルのユーザー定義で 

    前回、「1234511」で「12345A1-1」となるユーザー定義「00000"A"0"-"0」を使っている列で、 「12345B1」で「12345AB-1」にする方法を教えていただきましたが、さらに問題が発生しました。 「12345A67-1」という風にAの次の数字が二桁の場合が出てきて、「12345671」では 「123456A7-1」になってしまいます。前回教えていただいたコードをいじれば修正可能なのでしょうか? 新たに「12345671」の入力で「12345A67-1」となるようにしたいのです。 前回のコード private sub worksheet_change(byval Target as excel.range)  dim h as range  on error resume next  for each h in application.intersect(target, range("A:A")) ’実際に合わせて修正   if h <> "" then   h.numberformat = "0000A0-0"   if application.istext(h) then   application.enableevents = false   h = application.replace(h, len(h), 0, "-")   h = application.replace(h, len(h)-2, 0, "A")   application.enableevents = true   end if   end if  next end sub

  • 時間フォーマット VBA

    VBA初心者です。Javaなどはある程度できるレベルのものです セルにHH:mmフォーマットで時間を入力したくて以下のコードで実行すると12列目は正常に入力でき、 13列目にも同じように指定シたいです。 試したのは If IntersectからEnd Ifまでを最終行の手前にColumns(13)で全体を追加しました。 しかし、13列目はVBAが効いていません また、12列目に入力した値を消すと : (コロン)が残ってしまいます。 また、ThisWorkBookにこのコードを書いてもVBAが効いていません。 このファイルは作業中のシートに対するものでしょうか。 だとしたら、作業中シートに対して行うにはどう書いたらよいのかわからずにおります。 細かい質問ですみません。 ご存知か方がおられましたら教えてください。 よろしくお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Columns(12)) Is Nothing Or Selection.Count <> 1 Or Not IsNumeric(Target) Then Exit Sub ' Debug.Print "Target==" & Target If Target <= 2359 And Target Mod 100 < 60 Then ' Application.EnableEvents = False ' With Target ' If Len(Target) = 3 Then .Value = 0 & ":" & Right(Target, 2) ElseIf Len(Target) = 3 Then .Value = Left(Target, 1) & ":" & Right(Target, 2) Else .Value = Left(Target, 2) & ":" & Right(Target, 2) End If .NumberFormatLocal = "hh:mm" ' End With ' Application.EnableEvents = True ' Else MsgBox "入力値が不正です。" ' With Target ' .Value = "" .Select End With Exit Sub ' End If End Sub 'この行まで

  • エクセル マクロ 初心者です

    エクセルマクロ初心者です。 以下の2つの Private Sub Worksheet_Change(ByVal Target As Range)を1つのシートで実行させたいのですが、 当方、初心者なので組み合わせ方が分かりません。 よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止!" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ------------ 上記の2つを1つのシートで動作させたいのですが、うまくいきません。 単体では、動作します。

  • VBAの時間入力について

    先日、時間を文字列で、HH:mmのフォーマット入力するPGを教えて頂き、 内容理解をしているのですがわからない部分があります。 ★の部分の条件で、00:00も入力したいです。 ご存知か方がおられましたら教えてください。 よろしくお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から 'Intersect:http://officetanaka.net/excel/vba/tips/tips118.htm 'Is Nothing:nullではない 'Selection.Count <> 1:選択数が1以下ではない(<> :等しくない) ' Not IsNumeric(Target):数値ではない If Intersect(Target, Columns(12)) Is Nothing Or Selection.Count <> 1 _ Or Not IsNumeric(Target) Then Exit Sub ' 'Target:セルの値は24:00以下 '2つの数値の除算を行いし,その剰余を返す 'Mod:2つの数値の除算を行いし,その剰余を返す '★ここで00:00時も入力したい。 If Target <= 2400 And Target Mod 100 < 60 Then ' Application.EnableEvents = False ' With Target ' If Len(Target) = 3 Then .Value = 0 & ":" & Right(Target, 2) ElseIf Len(Target) = 3 Then .Value = Left(Target, 1) & ":" & Right(Target, 2) Else .Value = Left(Target, 2) & ":" & Right(Target, 2) End If .NumberFormatLocal = "hh:mm" ' End With ' Application.EnableEvents = True ' Else MsgBox "入力値が不正です。" ' With Target ' .Value = "" .Select End With Exit Sub ' End If End Sub 'この行まで

  • excel 2007 VBA コードの記述

    Excel 2007 を使用しています。 TEST.xlsm というブック内に テスト01 というシートを作成し、そのタブを右クリックして コードの表示 を選択。 表示されたVBAコード入力シートに下記のコードを記述して使用してます。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("E3:E33,G3:G33,AH3:AH33,AJ3:AJ33,BK3:BK33,BM3:BM33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 23 End If End If Application.EnableEvents = True End Sub 'この行まで この条件に新たに下記のコードを追加したいと思い ネット検索しながらあれこれ試行錯誤してますが まだまだVBA初心者のため上手く機能してくれません。 ※上のコードだけなら思った通りに機能します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("Y3:Y33,BB3:BB33,CE3:CE33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 30 End If End If Application.EnableEvents = True End Sub 'この行まで どなたかこれら二種のコードを一つにまとめた記述方法を 教えて頂けますでしょうか?

  • VBAについて教えてください。

    過去のQNo.457545であったのですが エクセルに20080801と入力すると 自動的に平成20年8月1日と表示されるVBAについて 下記の構文で可能ということでした。 この場合、変換がされるのは A1からA10までのセルだと思うのですが 加えてC1からC10も変換させるには どこかに入力を加えることで 可能になるでしょうか? よろしくお願いします。 QNo.457545にあった構文です。 Sheet1のコードウインドウに貼り付け ↓ Const HenkanAdr = "A1:A10" 'この範囲で機能する。変更して下さい Private Sub Worksheet_Change(ByVal Target As Excel.Range)   Dim txt As String   Application.EnableEvents = False   On Error GoTo ErrorHandler   If Target.Count = 1 Then     If Not Intersect(Target, Range(HenkanAdr)) Is Nothing Then       txt = Right("00000000" & Target.Text, 8)       txt = Left(txt, 4) & "/" & Mid(txt, 5, 2) & "/" & Right(txt, 2)       Target = Format(txt, "gggee年mm月dd日")     End If   End If   Application.EnableEvents = True   Exit Sub ErrorHandler:   Application.EnableEvents = True End Sub

  • 2つのVBAを組み合わせる方法

    お世話になります、2つのVBAを組み合わせる方法で迷っています。 1つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 2つめが Private Sub Worksheet_Change(ByVal Target As Range)  Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。2つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか?

  • 数字と数字のー(ハイフン)は消去しないVBA

    Private Sub Worksheet_Change(ByVal Target As Range) Dim myAsc As Integer, InSP As Integer, myFlag As Integer Dim myStr As String If Intersect(Target, Range("B4:CH4")) Is Nothing Then Exit Sub If Application.CountBlank(Target) > 0 Then Exit Sub Application.EnableEvents = False Target = StrConv(Target, vbUpperCase + vbNarrow) myStr = Target.Value InSP = 0: myFlag = 0 For i = 1 To Len(myStr) myAsc = Asc(Mid(myStr, i, 1)) If Not (myAsc >= 65 And myAsc <= 90) Then If Not (myAsc >= 48 And myAsc <= 57) Then If myAsc = 32 Then InSP = i Else MsgBox ("-(ハイフン)は使用出来ません。クリアします。" & "" & Mid(myStr, i, 1) & "") Target.Select ' Selection.ClearContents Application.EnableEvents = True Exit Sub End If ElseIf myFlag = 0 And InSP = 0 Then myFlag = i End If End If Next If myFlag <> 0 Then Target.Value = Left(myStr, myFlag - 1) & Mid(myStr, myFlag, 99) End If Application.EnableEvents = True End Sub B4:CH4の範囲で半角英数字の小文字で入力したら自動で大文字となり、-(ハイフン)を入力したら文字がクリアされるVBAがあります。 質問ですが先ほどのVBAで英字と数字の間のー(ハイフン)はクリア対象となり、数字と数字の間にー(ハイフン)の場合はクリアしないVBAはどの様にすれば良いでしょうか? ※「GRE-879」の時は消去対象となり、「GRE868-76」の時は消去しない感じです。

  • WorkSheet_Changeを2つ反映させる

     下記のコードをWorkSheetで2つ反映させるにはどうしたらいいでしょうか?どちらか一つなら反映するのはわかりますが、どう名前を変更すればいいのかお教え願えませんでしょうか? windows7・SP1 Office2010 Private Sub WorkSheet_Change(ByVal Target As Range) If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub '検査範囲 Application.EnableEvents = False '再帰実行の停止 If Range("C1").Value <> Sheets("祝祭日").Range("A1").Value Then MsgBox ("祝日の設定を反映するため年度を同じにしてください。") End If Application.EnableEvents = True End Sub Private Sub WorkSheet_Change(ByVal Target As Range) Dim MyRow As Long Dim MyCol As Integer MyRow = Target.Row MyCol = Target.Column With Worksheets("メイン・1").Select If MyRow = 1 And MyCol = 7 Then If Target = 4 Then 'または If Target = 1 Then メインデータの復元 '動かしたいマクロ名 End If End If End With End Sub

  • エクセル自動改行で互換性エラー

    エクセルで、1行35文字以上が記入されると自動で次のセルに改行される 仕様になるようにマクロを組んでいます。 ただ自身はマクロ未経験で、他のところから見様見真似で コードを調整してくっつけただけで、知識はほとんどありません。 そのため、エクセルのバージョンが違うとうまく動作しないようになっています。 どこの記述がおかしいのか、足りないのかわかりません。 制作環境:excel 2010 以下内容です。 ------------------------------------------- ' 改行自動 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim TgRng As Range Dim N As Integer Dim Ary() Dim S As String Set TgRng = Range("N10:N26") Set Rng = Intersect(TgRng, Target) If Rng Is Nothing Then Exit Sub Application.EnableEvents = False With Rng.Cells(1) If Len(.Value) > 36 Then S = .Value For N = 0 To Int((Len(S) + 35) / 36) ReDim Preserve Ary(N) Ary(N) = Left(S, 36) S = Mid(S, 37) If S = "" Then Exit For Next .Resize(UBound(Ary) + 1).Value = Application.Transpose(Ary) End If End With Application.EnableEvents = True Set Rng = Nothing Set TgRng = Nothing Erase Ary End Sub ' 切り取り禁止 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.CutCopyMode = 2 Then Application.CutCopyMode = 0 End If End Sub -------------------------------------------