[[20100419194005]]　『同一セル内での計算』（ヨシヒロ）　ページの最後に飛ぶ

『同一セル内での計算』（ヨシヒロ）

 同一セル内に数字を打ち込んでいくだけで、自動的に足し算にする方法はないでしょうか？
 マクロなどでもかまいません。
 こんな感じです！

 Ａ１に５分と入力
 その後また、Ａ１に１０分と入力する。
 合計１５分と表示できるようにしたいのですが詳しい方がいらっしゃいましたら宜しくお願いします。

 正直あまりお勧めできる仕様ではありません。
 入力ミスした場合にどう間違えたのかすらわからなくなりますし
 そもそも電卓のように使うのであれば表計算ソフトの意味すら無いと思いますので。

 まぁでも、下のようなコードで表示形式を0"分"などにしておけば可能は可能ですが・・・

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" And IsNumeric(Target.Value) Then
    Me.Range("B1").Value = Me.Range("B1").Value + Target.Value
  End If
  End Sub

 （ｍｏｍｏ）

 あ、意味が違うかな・・・？　こっちの意味かな？

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim buf As Double
  If Target.Address = "$A$1" And IsNumeric(Target.Value) Then
    Application.EnableEvents = False
    If Target.Value = 0 Then
      Target.ClearContents
    Else
      buf = Target.Value
      Application.Undo
      Target.Value = Target.Value + buf
    End If
    Application.EnableEvents = True
  End If
  End Sub

 （ｍｏｍｏ）

ありがとうございます。

お聞きしたいのですが、縦の列をＡ１からＡ１３など指定したい場合は以下の入力になるのですか？

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim buf As Double
  If Target.Address = "$A$1:$A$13" And IsNumeric(Target.Value) Then
    Application.EnableEvents = False
    If Target.Value = 0 Then
      Target.ClearContents
    Else
      buf = Target.Value
      Application.Undo
      Target.Value = Target.Value + buf
    End If
    Application.EnableEvents = True
  End If
  End Sub

 > If Target.Address = "$A$1:$A$13" And IsNumeric(Target.Value) Then
 この1行を

  If Target.Count > 1 Then Exit Sub
  If Not Application.Intersect(Target, Me.Range("A1:A13")) Is Nothing And _
     IsNumeric(Target.Value) Then

 の3行に書き換えてください。
 （ｍｏｍｏ）

 こんにちは。横からお邪魔します^^/
 A1:A13を対象とするのなら、こんな感じにしても良いかも～。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim TValue, buf, Buf2
    Dim i As Long
    Dim R As Range

    If Target.Areas.Count <> 1 Then Exit Sub
    Set R = Intersect(Target, Range("A1:A13"))
    If R Is Nothing Then Exit Sub

    TValue = Target.Value
    buf = R.Value

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Undo

    Buf2 = R.Value
    Target.Value = TValue

    If Target.Count = 1 Then
        If IsNumeric(buf) And Not IsEmpty(buf) Then
            R.Value = buf + Val(Buf2)
        Else
            R.Value = Empty
        End If
        Application.EnableEvents = True
	Application.ScreenUpdating = True
        Exit Sub
    End If

    For i = 1 To UBound(buf, 1)
        If IsNumeric(buf(i, 1)) And Not IsEmpty(buf(i, 1)) Then
            buf(i, 1) = buf(i, 1) + Val(Buf2(i, 1))
        Else
            buf(i, 1) = Empty
        End If
    Next

    R.Value = buf
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 End Sub
 (はち）

ありがとうございます。

この場合、３０分と入力してあった場合、次に入力する数字を間違えた場合に、前の３０分に戻れるように出来るのでしょうか？

はちさんのですと、０を押したときは前の数字のままです。

いい方法がありましたら教えて頂きたいと思います。

 そのような問題が発生するので、お勧めできません。と先に記述したつもりですが・・・
 結局、入力履歴をどこかに残さなければそのような事は出来ないと思います。
 なので、最初から表計算ソフトの本来の使い方のとおり順次入力していって
 SUM関数などで足すようにすればいいのです。
 （ｍｏｍｏ）

入力履歴をＢ１に、合計として残して記憶を繰り返し残すことはできるのでしょうか？

もし駄目ならあきらめます。

いろいろと教えて頂きありがとうございます。

 入力確定後、確定前に戻れるようには作っていません(v_v )

 momoさんもおっしゃっていますが、
エクセルの機能を普通に使いたいのであれば、マクロの介入はNGです。
それならばセオリー通り、セルを分けて入力するのがよろしいかと思います。

 でも一応。
一セル入力だけを対象にしたいのならば、B1に履歴は可能です。
その場合は改変が簡単な、momoさんの方のコードをお勧めします^^/

 ちなみに僕のは0では無く、数字以外の入力で初期化するようにしています。
# 間違って編集を開始してしまったら、0で確定する事でもエスケープになるかと。
ここ0で初期化が、良かったのかしらん？（はち）

 履歴を残しておくとして、どんなタイミングor入力文字でUndoさせるのかが必要ですね。
 （ｍｏｍｏ）

 とりあえず
 A1:A13が入力範囲　履歴をそれぞれB1:B13に残す
 １つ前に戻る場合はA列のセルに「bs」と入力（バックスペースという意味で）
 完全に消す時はDeleteキーで消す

 以上を条件に以下のコードをサンプルとして載せておきます。

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim buf As Variant
  If Target.Count > 1 Then Exit Sub
  If Not Application.Intersect(Target, Me.Range("A1:A13")) Is Nothing Then
    Application.EnableEvents = False
    Select Case VarType(Target.Value)
      Case vbString
        If StrConv(Target.Value, vbNarrow + vbLowerCase) = "bs" Then
          If Target.Offset(, 1).Value = "" Then
            Target.ClearContents
          Else
            Application.Undo
            buf = Split(StrReverse(Target.Offset(, 1).Value), ",", 2)
            Target.Value = Target.Value - CDbl(StrReverse(buf(0)))
            Target.Offset(, 1).Value = StrReverse(buf(1))
          End If
        Else
          Application.Undo
        End If
      Case vbDouble
        buf = CDbl(Target.Value)
        Application.Undo
        Target.Value = Target.Value + buf
        Target.Offset(, 1).Value = Target.Offset(, 1).Value & "," & buf
      Case vbEmpty
        Target.Resize(, 2).ClearContents
    End Select
    Application.EnableEvents = True
  End If
  End Sub

 （ｍｏｍｏ）

本当にご無理を言って申し訳ありません。

これを機会にもっと勉強しないといないと思います。

今回は本当にありがとうございました。

本当に申し訳ないのですがＤ列にするにはどうすればいいのでしょうか？

 何をＤ列ですか？
 入力セルなら
  If Not Application.Intersect(Target, Me.Range("A1:A13")) Is Nothing Then
 ここをＤ列の範囲に

 履歴なら各所にある
 Offset(, 1)　を　Offset(, 3)　に変更です。

 （ｍｏｍｏ）

履歴を残すをB1:B13になっているのを、C1:C13やD1:D13に変更はどうしたらできるのですか？

Offsetを変更だけで宜しいでしょうか？

 そのとおりです。
 Offsetの数字を変えてください。
 B列＝A列の1列右なのでOffset(,1)
 C列＝A列の2列右なのでOffset(,2)
 D列＝A列の3列右なのでOffset(,3)

 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100419194005]] 『同一セル内での計算』（ヨシヒロ） ページの最後に飛ぶ

[[20100419194005]]　『同一セル内での計算』（ヨシヒロ）　ページの最後に飛ぶ