続・エクセルのユーザー定義で12345B1で12345AB-1にする方法

このQ&Aのポイント
  • エクセルのユーザー定義で「12345B1」で「12345AB-1」にする方法を教えてください。
  • 「12345A67-1」という風にAの次の数字が二桁の場合が出てきて、「12345671」では「123456A7-1」になってしまいます。前回教えていただいたコードをいじれば修正可能なのでしょうか?
  • 新たに「12345671」の入力で「12345A67-1」となるようにしたいのです。
回答を見る
  • ベストアンサー

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

前回、「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

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

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

こんばんは! 表示形式の操作ではなく、データそのものを変えてしまうコトになりますが・・・ 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 ※ A列に入るデータの文字数は7、もしくは8という前提です。 ※ 元データを変更させたくない場合は無視してください。m(_ _)m

yatchky303
質問者

お礼

ありがとうございます。出来ました。 元データが変わるというのは全然構いません。ユーザー定義も必要なくなるということですね。 今夜はよく眠れそうです。

その他の回答 (1)

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

次のようなコードにすればよいでしょう。 Private Sub worksheet_change(ByVal Target As Excel.Range) Dim h As Range Dim myStr As String On Error Resume Next For Each h In Application.Intersect(Target, Range("A:A")) '実際に合わせて修正 Application.EnableEvents = False If IsNumeric(h) Then myStr = h If Len(myStr) = 8 Then h = Left(String:=myStr, Length:=5) & "A" & Mid(String:=myStr, Start:=6, Length:=2) & "-" & Right(String:=myStr, Length:=1) ElseIf Len(myStr) = 7 Then h = Left(String:=myStr, Length:=5) & "A" & Mid(String:=myStr, Start:=6, Length:=1) & "-" & Right(String:=myStr, Length:=1) End If End If Application.EnableEvents = True Next End Sub

yatchky303
質問者

補足

ご回答ありがとうございます。 出来た!と思ったのですが、前回の「12345B1」で「12345AB-1」にすることが出来なくなりました。 前回のコードのどこかを追加すればいいのかと思うのですが、素人ゆえ分かりません。 宜しくお願い致します。

関連するQ&A

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

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

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

    エクセルマクロ初心者です。 以下の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つのシートで動作させたいのですが、うまくいきません。 単体では、動作します。

  • 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ですが、どのようにして組み合わせれば良いのでしょうか?

  • エクセル 加算 

    1つのセルに数字を入力すると加算されているマクロを探していたら 以下の回答がありました Dim memo Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value <> "**" And IsNumeric(Target.Value) = False Then Exit Sub Application.EnableEvents = False If Target.Value = "**" Then memo = 0 Else memo = memo + Target.Value End If Target.Value = memo Application.EnableEvents = True End Sub このマクロですがA1に入力した場合に適用しますが、このマクロをたとえばA1からC1の範囲で使用した1場合にどのようなマクロをすればよいかわかりません それか、このマクロではそのようなことができるのかもわかりませんので教えて頂けないでしょうか

  • Excelのプロシジャーで有効範囲のセルを限定したい

    Excelの「コードの表示(V)」に、下記のフォントサイズ変更コードを登録してあります。この有効範囲を、あるセル範囲、たとえば(C3:S20) などのように限定したいのですが、どう記述したらよいのでしょうか、教えて下さい。よろしくお願いします。 (現在のコード) Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Application.EnableEvents = False For Each c In Target If IsNumeric(c.Value) Then If Len(Mid$(c.Text, InStr(c.Text, ".") + 1)) > 1 Then c.Font.Size = 8 Else c.Font.Size = 9 End If End If Next c Application.EnableEvents = True 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(エクセル)でのCOUNTAについて

    エクセルのSheet1のB列にSheet2の内容をコピーして、(ここまではできました) Sheet1のB列に入ってきたデータの横(A列に)連番を振りたいと思っています。 そのため、以下のように作ってみたのですが、 A列に表示される連番が現在のB列の最後の数“54”をA列全て(B列にデータがあるところ)に表示してしまいます。 どの部分が悪いのかさっぱりわからず、どのように修正すべきかもわからず・・・困ってしまっています。 よろしくお願いします。 Dim i As Range Dim mycount As Range Set mycount = Application.Intersect(Target, Me.Range("b:b")) If mycount Is Nothing Then Exit Sub End If Application.EnableEvents = False For Each i In mycount If IsEmpty(i.Value) Then i.Offset(0, -1).ClearContents Else i.Offset(0, -1).Value = Application.WorksheetFunction.CountA(Range("b2:b200")) End If Next i Application.EnableEvents = True End Sub

  • エクセルVBAで重複入力の排除

    すでに入力規則はリストで使用しております。 そのためVBAで重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range)    Dim myDic As Object    Dim c As Variant, varData As Variant    Dim i As Long    If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub    Set myDic = CreateObject("Scripting.Dictionary")    varData = Range("A1:A50").Value    For Each c In varData      If Not c = Empty Then        i = i + 1        If Not myDic.Exists(c) Then          myDic.Add c, Null        End If      End If    Next    If myDic.Count < i Then     MsgBox Target & " は重複!"     Application.EnableEvents = False     Application.Undo     Application.EnableEvents = True    End If End Sub

  • エクセル VBAマクロ if文 はどうすれば?

    先ほど質問したのですが、さらにわからなくなったのでお願いします 先ほどの質問 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ http://okwave.jp/qa/q7236338.html >変数と式の両立は難しいでしょうからどうすればよいのでしょう?  ⇒関数では出来無いのはエクセルの常識ですのでマクロ(VBA)組込みになります。 一例です。 対象シートタブ上で右クリック→コードの表示→以下のコード貼り付けてA1に枚数を入力して お試しください。 サンプルコード Private Sub Worksheet_Change(ByVal Target As Range) 単価 = 5 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then  Application.EnableEvents = False  Target.Value = Target.Value * 単価  Application.EnableEvents = True End If End Sub ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ↓変更&応用したのですが、、、、 EX:(セル)    セル番号  用紙種類1~3       用紙種類    C12   A3モノクロ1     D12  A3カラー1    C13   A3モノクロ2     D13  A3カラー2    C14   A3モノクロ3     D14  A3カラー3 ※金額の違いは、モノクロとカラーの値段が違うだけ  1~3は金額的な違いはない とあった場合、 ためしに先ほどのを応用して用いたのですが 変更点は、用紙サイズ、カラーの有無による金額        出力先セルの番号 Private Sub Worksheet_Change(ByVal Target As Range) を Private Sub A4_mono_1(ByVal Target As Range) Private Sub A4_mono_2(ByVal Target As Range) ・             ・            ・ と変更したのですがうまく動作しなかったのですが、 どういった点が悪かったのでしょうか? ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 最終的な質問↓ 上記のものはVBAマクロ文は基本1つのみなので、if文で作らなくてはいけないということが分かったのですが、そこでさらに疑問が浮かびました、 Private Sub Worksheet_Change(ByVal Target As Range) If or(target.columns = C12:C14) Then 単価1 = 7.6 If Intersect(Target, Range("C12:C14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価1 Application.EnableEvents = True単価1 = 7.6 elseif or(target.columns = D12:D14) Then 単価2 = 30.6 If Intersect(Target, Range("D12:D14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価2 Application.EnableEvents = True End If End Sub としたっ場合全く式になっていません どのようにすればよいのでしょう?

  • excel2007 VBで

    下記のマクロ作成して実際にセルにA、あるいは何かデータを入力しても下記イベント?が発生している気配がありません。 Application.EnableEvents = Falseの行がなにか問題なのでしょうか。実プログラムは If Target.Value = "A" Or Target.Value = "A" Thenの他にB、C、計算も含んでいるのですがApplication.EnableEvents = TrueはEnd Subの前行に入れてあります。 他に設定することがあるのでしょうか。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 Application.EnableEvents = False '割込み停止 ’[B3] = 123 ’Stop If Target.Value = "A" Or Target.Value = "A" Then Target.Value = "A" End If Application.EnableEvents = True '割込み再開 End Sub excel2007 VB6.5です。