A1に数字を入力するとB1に加工して転記するマクロ

Question

A1に入力されるのを監視して、入力された数字を加工してB1に自動的に転記するマクロを書きたいのですが、どのようにすればよいでしょうか？
他の質問（http://oshiete.goo.ne.jp/qa/3163895.html）から、こんな感じかなと思うのですが、【B1に下一桁を切り落として、転記】の部分をどう書いていいのか分かりません。
例えば、A1に「12345」と入力された場合、B1は「1234」を入力したいのです。

よろしくご指導ください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

if Range("A1") <>"" then

【B1に下一桁を切り落として、転記】

End Sub

tom04 · Accepted Answer

こんにちは！

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Address = "$A$1" And IsNumeric(.Value) Then
            .Offset(, 1) = Int(.Value / 10)
        End If
    End With
End Sub

こんなんではどうでしょうか？m(_ _)m

KURUMITO · Answer

次のようなマクロにしてはどうでしょう。

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells = Range("A1") Then
a = Target.Value / 10
Range("B1").Value = Int(a)
End If
End Sub

okgoripon · Answer

変更が必ず1セルごとなら問題ないのですが、例えばコピペなどで複数のセルが書き換わった場合、普通にIfで比較しても反応しませんので、もうちょっと工夫しないといけません。

'A1セル1個だけ処理出来ればいい場合
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　'Targetに入っている「変更のあった範囲」にA1が含まれているか調べる
　　If (Not (Intersect(Target, Range("A1")) Is Nothing)) Then
　　　　Range("B1").Value = Range("A1").Value \ 10
　　End If
End Sub

'セル複数に対して処理が必要な場合
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　'Targetから「変更のあったセル」を1個ずつ取り出す
　　For Each c In Target
　　　　If c.Cells = Range("A1") Then
　　　　　　Range("B1").Value = c.Value \ 10
　　　　Else If c.Cells = Range("A2") Then
　　　　　　'サンプル
　　　　　　Range("B2").Value = c.Value * 10
　　　　End If
　　Next
End Sub

後者の場合、If文の代わりにSelect Caseなどで比較しても構いません。
というか、数が多くなるならそうするべきでしょう。

あと、演算子「\」は「整数割り算の商を計算する」演算子です。

エラー処理は書いていないので、適宜足してください。

MarcoRossiItaly · Answer

「Worksheet_SelectionChange」とすると、入力と同時にカーソルを動かさない限り、記入が実行されません。例えば Ctrl+Enter で A1 セルに入力すると、失敗します。なので「Worksheet_Change」が望ましいかと思います。

「7.89」→「7.8」、「-7.89」→「-7.8」というふうに丸めるコード書いてみました。2 桁以上の整数の場合は、1 の位を削ります。1 桁の整数や文字列を入力したときは、B1 を空白にします。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim n As Integer, x1 As Double, x2 As Double

On Error Resume Next

With Range("b1")
　　If Target.Address = "$A$1" Then
　　　　.ClearContents
　　　　With Target
　　　　　　n = Len(.Value) - InStr(.Value, ".")
　　　　　　x1 = Int(Abs(.Value) * 10 ^ (n - 1)) / 10 ^ (n - 1)
　　　　　　x2 = Sgn(.Value) * x1
　　　　End With
　　　　If Int(Target.Value) < Target.Value Then
　　　　　　.Value = x2
　　　　Else
　　　　　　.Value = Target.Value \ 10
　　　　End If
　　　　If .Value = 0 Then
　　　　　　.ClearContents
　　　　End If
　　End If
End With

End Sub

A1に数字を入力するとB1に加工して転記するマクロ

次のようなマクロにしてはどうでしょう。

こんにちは！

変更が必ず1セルごとなら問題ないのですが、例えばコピペなどで複数のセルが書き換わった場合、普通にIfで比較しても反応しませんので、もうちょっと工夫しないといけません。

「Worksheet_SelectionChange」とすると、入力と同時にカーソルを動かさない限り、記入が実行されません。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング