[[20100419194005]] 『同一セル内での計算』(ヨシヒロ) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『同一セル内での計算』(ヨシヒロ)
 同一セル内に数字を打ち込んでいくだけで、自動的に足し算にする方法はないでしょうか?
 マクロなどでもかまいません。
 こんな感じです!

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

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

 まぁでも、下のようなコードで表示形式を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

 (momo)

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

  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

 (momo)

ありがとうございます。

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

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行に書き換えてください。
 (momo)

 こんにちは。横からお邪魔します^^/
 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
 (はち)

ありがとうございます。

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

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

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


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

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

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

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


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

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

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

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

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

 とりあえず
 A1:A13が入力範囲 履歴をそれぞれB1:B13に残す
 1つ前に戻る場合は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

 (momo)

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

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

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


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


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

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

 (momo)

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

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


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

 (momo)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.