ここから本文です

Excel VBA で英数含む文字列の下二桁に数を自動で+する C列に「012ABC01」(上...

アバター

ID非公開さん

2019/3/2516:23:59

Excel VBA で英数含む文字列の下二桁に数を自動で+する

C列に「012ABC01」(上6桁は英数字込み、下2桁は数字は固定)
のような文字列を下に随時追加して入力していくのですが、

入力した後に、その文字列の同じ行のF列に「A」,「B」等を入力し、
「A」を入力した場合「C列の文字列の下二桁の数字に+1」、
「B」を入力した場合「C列の文字列の下二桁の数字に+2」、のように自動でプラスされるようなものが作りたいのですが、どうしたらよいでしょうか。

理想の実行例ですが、
C5に「012ABC01」と入力されており、F5に「A」と入力したら
C5の値が「012ABC02」となるようなイメージです。
「B」であれば「012ABC03」
それ以外はそのままです。

分かりづらい部分もあるかと思いますが、ご教授お願い致します。

閲覧数:
58
回答数:
3
お礼:
50枚

違反報告

ベストアンサーに選ばれた回答

kik********さん

2019/3/2518:04:15

雰囲気、以下でどうなりますか

012ABC99 の時、A が入力されたら 013ABC00 に・・・
012ABC99 の時、B が入力されたら 013ABC01 に・・・

012ABC の時、A が入力されたら 013ABC に・・・

列全体の操作があるのか分かりませんが、
確認されるのなら、
何パターンか確認後、F 列に1列挿入し、その挿入した列を削除してみる
元々 F 列だった値で、C 列が更新されるかと・・・・

どうなりますか


Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rng As Range
   Dim i As Long

   Set Target = Intersect(Target, Columns("F"), Me.UsedRange)
   If (Target Is Nothing) Then Exit Sub

   Application.EnableEvents = False
   For Each rng In Target
      i = 0
      Select Case rng.Value
         Case "A": i = 1
         Case "B": i = 2
      End Select

      If (i > 0) Then
         With rng.EntireRow.Range("C1")
            .Value = fncSamp1(.Value, i)
         End With
      End If
   Next
   Application.EnableEvents = True
End Sub


Private Function fncSamp1(ByVal sSrc As String _
                  , ByVal jNum As Long) As String
   Dim sS As String
   Dim i As Long

   If (jNum > 0) Then
      For i = Len(sSrc) To 1 Step -1
         sS = Mid(sSrc, i, 1)
         If (sS Like "#") Then
            jNum = jNum + Val(sS)
            Mid(sSrc, i, 1) = jNum Mod 10
            jNum = jNum \ 10
            If (jNum = 0) Then Exit For
         End If
      Next
   End If
   fncSamp1 = sSrc
End Function

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

mn1********さん

2019/3/2520:37:22

下2桁が00~09の時0が消えてしまって苦労しました。
ちょっと苦しまみれですが一応動作します。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Set myRng = Cells(Target.Row, 3)

If Target.Count > 1 Then Exit Sub

If Target.Column = 6 And Target = "A" Then
If InStr(Right(myRng, 2), 0) > 0 Then
myRng = Left(myRng, 6) & Right(myRng, 2) + 1
myRng = Left(myRng, 6) & "0" & Right(myRng, 1)
Else
myRng = Left(myRng, 6) & Right(myRng, 2) + 1
End If
ElseIf Target.Column = 6 And Target = "B" Then
If InStr(Right(myRng, 2), 0) > 0 Then
myRng = Left(myRng, 6) & Right(myRng, 2) + 2
myRng = Left(myRng, 6) & "0" & Right(myRng, 1)
Else
myRng = Left(myRng, 6) & Right(myRng, 2) + 2
End If
Else
Exit Sub
End If
End Sub

hel********さん

2019/3/2516:48:14

シートイベントで実行。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 Or Target.Count > 1 Then Exit Sub
If Target.Value = "A" Then
Cells(Target.Row, "C") = Left(Cells(Target.Row, "C"), 6) & Format(Right(Cells(Target.Row, "C"), 2) + 1, "00")
ElseIf Target.Value = "B" Then
Cells(Target.Row, "C") = Left(Cells(Target.Row, "C"), 6) & Format(Right(Cells(Target.Row, "C"), 2) + 2, "00")
End If
End Sub

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる