[[20080920113200]] 『入力した内容を履歴として残したい』(きよ) ページの最後に飛ぶ

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

 

『入力した内容を履歴として残したい』(きよ)

   | A | B | C | D | E |
 1 |あて先|               |
 2 |金 額|               |
 3 |備 考|               |
 
 このような入力シート(BCDEは結合セル)を作り、印刷用シートに
 反映されるようにしています。
 入力された内容を別シートに履歴として残しておきたいと思い
 自動記録でマクロを登録したのですが、セルが結合されているためか
 うまくいきませんでした。

   | A | B | C | D |
 1 |あて先|金 額|備 考|提出日|
 2 |   |   |   |   |
 3 |   |   |   |   |
 
 
 よくを言えば、履歴は新しいものが2の行に入り、
 古いものが下に下がっていくようにして作成した日を
 提出日として残したいです。

 どうぞよろしくお願い致します。

 具体的に自分でどの部分までやってみて、どこのコードで躓いたのでしょう。
 皆目見当が付かないから、やりたいコードを全部書いてくれと言っているのですか?

 (Dil)


 全部書いちゃいました_/ ̄|○ il||li
 シート名等はお使いのものにあわせて適宜直してください。
Sub Test鮎()
Dim Data1 As String
Dim Data2 As Currency
Dim Data3 As String
Dim Data4 As Date
Dim myData
Const Input_Sh As String = "入力シート"
Const Data_Sh As String = "データシート"
With Worksheets(Input_Sh)
    Data1 = .Range("B1").Value
    Data2 = .Range("B2").Value
    Data3 = .Range("B3").Value
    Data4 = Date
End With
myData = Split(Data1 & "," & Data2 & "," & Data3 & "," & Data4, ",")
With Worksheets(Data_Sh)
    .Rows("2:2").Insert Shift:=xlDown
    .Range("A2").Resize(1, 4).Value = myData
End With
End Sub

 相変わらず配列の使い方が上手く出来ない_/ ̄|○ il||li

 (川野鮎太郎)

 えーと,まずセルの結合はしなくて済む場合は極力避けた方がよいと思います。
 試してください。

 Private Sub Worksheet_Change(ByVal Target As Range)
 With Target.MergeArea(1)
     If (.Address(0,0) <> "B3") + (.Value = "") Then Exit Sub
 End With
 If vbYes = MsgBox("データを転送しますか?,vbYesNo) Then
     With Sheets("履歴")
         .Rows(2).Insert
         .Range("a2").Resize(,4).Value = _
         Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Ragne("b3").Value)
     End With
 End If
 End Sub
 (seiya)


 Dilさん 川野鮎太郎さん seiyaさん ありがとうございます。

 seiyaさんが教えてくださったのは
 B3に文字が入力されたら実行されるという事なのでしょうか。
 A1に文字を入力するとエラーがでてしまいました。
 何かこちらで付け加えなくてはいけないのでしょうか。
 すみません本当に初心者で、意味を理解することができなくて。

 (きよ)

 >すみません本当に初心者で、意味を理解することができなくて
 やはり、プロに依頼すべきかな。
 (トオリスガリ)

 そうですか...
 これで試してください。
 ちなみに、コードはシートモジュールに貼り付けていますよね?

 Private Sub Worksheet_Change(ByVal Target As Range)
 With Target.MergeArea(1)
     If .Address(0,0) <> "B3" Then Exit Sub
     If .Value = "" Then Exit Sub
 End With
 End With
 If vbYes = MsgBox("データを転送しますか?,vbYesNo) Then
     With Sheets("履歴")
         .Rows(2).Insert
         .Range("a2").Resize(,4).Value = _
         Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Ragne("b3").Value)
     End With
 End If
 End Sub
 (seiya)


 seiyaさんへ

 >If vbYes = MsgBox("データを転送しますか?,vbYesNo) Then
 If vbYes = MsgBox("データを転送しますか?",vbYesNo) Then

 >With Sheets("履歴")
 当方の環境ではシート名を"履歴"へ変更しようとすると
 「予約語の為、使用できません」とメッセージが表示されます。

 >Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Ragne("b3").Value)
 Array(.Range("b1").Value, .Range("b2").Value, .Ragne("b3").Value)

 では、ありませんか。 (mitsu)

 mitsuさん、どうもです。
 "履歴" そうですか、予約語でしたか、知りませんでした。

 > Array(.Range("b1").Value, .Range("b2").Value, .Ragne("b3").Value)
 は ちがうと思います。

 こんな感じでどうでしょう..

 Private Sub Worksheet_Change(ByVal Target As Range)
 With Target.MergeArea(1)
     If .Address(0,0) <> "B3" Then Exit Sub
     If .Value = "" Then Exit Sub
 End With
 End With
 If vbYes = MsgBox("データを転送しますか?",vbYesNo) Then
     With Sheets("転送先シート名")  '<- 変更してください。
         .Rows(2).Insert
         .Range("a2").Resize(,4).Value = _
         Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Ragne("b3").Value,Date)
     End With
 End If
 End Sub
 (seiya)

 seiyaさんへ

 >Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Ragne("b3").Value)
 が違うと指摘させていただいたのは、「メソッドまたはデータメンバがみつかりません」と
 表示されるためです。(Meがあるためと判断したのです。)

 その後、動作を検証しましたが同じ箇所でエラーになります。 
 ※End Withも一つ多いようです。
 (mitsu)


 「Me.Ragne("b3").Value」ここの綴りが違うと思いますが。
 私は、seiyaさんの最初のコードから
  1.メッセージの終わりの「"」を追加
  2.履歴を残すシート名を、実際のシート名に変更
  3.上記部分を、「Me.Range(・・・」に変更
 で、動きましたが・・・。

 ただ、日付は入力シートに入力されているのではないので
 「.Range("a2").Resize(, 4).Value」
 ここは、「3」に変更して、4つ目(D列)には
 今日の日付を入れるコードが必要になると思います。

 記録マクロで作るなら
  1.履歴を残すシートを選択
  2.2行目を選択し右クリック→行の挿入
  3.A2セルに =IF(入力シート!B1="","",入力シート!B1)
    B2セルに =IF(入力シート!B2="","",入力シート!B2)
      C2セルに =IF(入力シート!B3="","",入力シート!B3)
      D2セルに =TODAY()
    を入力
  4.A2:D2セルをコピーし、同じ場所へ値貼り付け
  5.入力シートに戻る
 と言う手順でも良いかもしれません。 

 (HANA)


 HANAさんまで、どうもです。
 それと、お騒がせいたしております。

 こんな感じでしょうか...

 Private Sub Worksheet_Change(ByVal Target As Range)
 With Target.MergeArea(1)
     If .Address(0,0) <> "B3" Then Exit Sub
     If .Value = "" Then Exit Sub
 End With
 If vbYes = MsgBox("データを転送しますか?",vbYesNo) Then
     Application.EnableEvents = False
     With Sheets("転送先シート名")  '<- 変更してください。
         .Rows(2).Insert
         .Range("a2").Resize(,4).Value = _
         Array(Me.Range("b1").Value, Me.Range("b2").Value, Me.Range("b3").Value,Date)
     End With
     Application.EnableEvents = True
 End If
 End Sub
 (seiya)


 seiyaさんへ

 >入力シート(BCDEは結合セル)
 こちらを見落としていました。

 どうもお騒がせ致しました。
 (mitsu)

 mitsuさん、HANAさん、どうもありがとうございます。
 とりあえず、転記先に他のイベントコードが記述されている場合も想定して
 コードに2行追加しました。
 (seiya)

みなさんありがとうございます。

 実行することができました。
 本当に感謝です。
 これから少しずつ自分でも勉強していきたいと思います。

 で、わがままなのですが・・・
 最初に説明をするべきだったのですがB1〜B3の他にも入力する
 項目がいくつかあって、その中のB1〜B3を履歴として残したいのです。
 なので、出来れば自動?ではなく一回一回マクロを実行したいと思うのですが。
 その場合はどうしたら良いでしょう。
 本当に申し訳ありません。

 (きよ)

 そのままですけど

 Sub test()
 Dim ws As Worksheet
      Set ws = Activesheet
      With Sheets("転送先シート名")  '<- 変更してください。
         .Rows(2).Insert
         .Range("a2").Resize(,4).Value = _
         Array(ws.Range("b1").Value, ws.Range("b2").Value, ws.Range("b3").Value,Date)
     End With
 End Sub
 (seiya)

 ありがとうございます。
 seiyaさんに作って頂いた『データを転送しますか?』を
 どうしても使いたくて自分なりに変更してみました。

 Sub tesuto()
 If vbYes = MsgBox("データを転送しますか?", vbYesNo) Then
     Application.EnableEvents = False
     With Sheets("データシート")    '<- 変更してください。
         .Rows(2).Insert
         .Range("a2").Resize(, 4).Value = _
         Array(Range("b1").Value, Range("b2").Value, Range("b3").Value, Date)
     End With
     Application.EnableEvents = True
 End If
 End Sub

 これで良いでしょうか。
 (きよ)


 いいと思いますが?
 (seiya)

 ありがとうございます。

 今回は古いものを下に下げるということで
 .Rows(2).Insertで2行目に1行挿入?

 新しいものを下へ順番に追加していくことも可能ですか?

 (きよ)

     With Sheets("データシート")    '<- 変更してください。
         .Rows(2).Insert
         .Range("a2").Resize(, 4).Value = _
         Array(Range("b1").Value, Range("b2").Value, Range("b3").Value, Date)
     End With
 を
 Sheets("データシート").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 4).Value = _
 Array(Range("b1").Value, Range("b2").Value, Range("b3").Value, Date)

 に変更してみてください。
 (seiya)

 ありがとうございます。
 seiyaさんはプロの方?
 親切に教えてくださって本当にありがとうございました。

 (きよ)

 > seiyaさんはプロの方?
 Excel/VBA のプロではありません。
 (seiya)

 とても詳しいので、そういうお仕事なのかと(笑)
 すみませんでした。

 他の人の質問でもあったのですが、履歴として残した項目を
 元に戻すにはどうしたら良いですか。
 例えばA列のあて先をダブルクリックするとその行の項目が
 入力シートにコピーされるとか。

 甘えてばかりですみません

 (きよ)

 SelectionChange イベントがあるので研究してみてください。
 私はここで落ちます。
 (seiya)


コメント返信:

[ 一覧(最新更新順) ]


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