[[20120512133720]]　『あるセルに入力した値を記録し平均や表を作成した』（＠初心者）　ページの最後に飛ぶ

『あるセルに入力した値を記録し平均や表を作成したい』（＠初心者）

はじめまして。
よろしくお願いします。

自分がしたいことをどう検索したらよいものか分からず質問することにしました。
同じような質問がありましたら申し訳ございません。

あるセルに入力した値を別の表（セル？）に記録していきたいのですがどうすればよいか分かりません。
（説明するのが難しくてうまく伝わらないかもしれません；）

A1にデータを入力します。
B1に数値を入力します。
4:5行（A4:A5、B4:B5などの結合セルです）にデータの種類が入力されています。
A1のデータと一致した列の下に数値が入力されるようにしたい。

A1、B1のセルに毎回データを入力するので入力したデータや数値は消えますが、過去のデータを残しておきたいのと各データの平均を求めたいのでどうにかできないかと思っています。

例えば、
A1に「りんご」、B1に「10」と入力した時、
4:5行目の「りんご」のセル（D4:D5）の行（D6）に「10」と入力され、
つぎに「りんご」、「4」と入力したとき、
先ほど入力された「10」のセルの下のセル（D7)に「4」と入力される。
「りんご」の平均をD3に入力。
っといったようにしたいです。

うまく伝えられなくて申し訳ないです。
どうかよろしくおねがいします。

（＠初心者）

 希望通りにはなっていませんが、Ａ１セルに入力してChangeイベントで
 InputBox関数が表示、数値を入力すると確認して、追加させれていく予定
 'そのシートモジュールに
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myi, mym As Double

    If Target.Address = "$A$1" And Target.Count Then
        If Target <> "" Then
            myi = InputBox(Target.Text & "　の" & vbLf & "数値を入力して下さい", "入力")
            If IsNumeric(myi) Then
                mym = MsgBox(Target.Text & vbLf & "   " & myi & vbLf & "これで、宜しいですか？", vbYesNo, "確認")
                If mym = 6 Then
                    Call Find_posting(Target.Text, myi)
                End If
            Else
                MsgBox "転記しませんでした"
            End If
        End If
    End If
 End Sub
 '標準モジュールに
 Sub Find_posting(ByVal myKey As String, ByVal myval As Double)
    Dim srng As Range, rorng As Range, sva As Variant
    Application.EnableEvents = False
    With ActiveSheet.Range("a4:z4")                                                     '行全体で良いなら　With ActiveSheet.rows(4)と変更
        Set srng = .Find(What:=myKey, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, MatchByte:=False)
        If Not srng Is Nothing Then                                                                         '検索結果　有

            Set rorng = Columns(srng.Column).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)                             '値が入っているまでのセル
            rorng.Offset(1).Value = myval
            srng.Offset(-1).Value = Evaluate("AVERAGE(" & srng.Address & ":" & rorng.Offset(1).Address & " )") '平均を転記
        Else                                                                                                '検索結果　無 新規登録するセルを探す
            On Error Resume Next
            Set srng = .SpecialCells(xlCellTypeBlanks)                                                      'エラーの場合空白が存在しない
            On Error GoTo 0
            If srng Is Nothing Then MsgBox "範囲内にデーターを登録出来ないので終了します": GoTo ego        '終了させる
            sva = Split(Replace(srng.Address, ":", ","), ",")
            Range(sva(0)).Resize(2).Merge                                                                   '結合
            Range(Range(sva(0)).Offset(-1).Address & "," & Range(sva(0)).Offset(1).Address).Value = myval   '新規登録　数値
            Range(sva(0)).Value = myKey                                                                     '新規登録　項目
        End If
 ego:
    End With
    Application.EnableEvents = True
    Set srng = Nothing
    Set rorng = Nothing
endsub
 （beginner） へんてこりんなコードになっちゃった

コメント返信：

[ 一覧(最新更新順) ]

[[20120512133720]] 『あるセルに入力した値を記録し平均や表を作成した』（＠初心者） ページの最後に飛ぶ

[[20120512133720]]　『あるセルに入力した値を記録し平均や表を作成した』（＠初心者）　ページの最後に飛ぶ