[[20130522160231]]　『シートの入力と蓄積の自動記録』（みんみん）　ページの最後に飛ぶ

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

　

『シートの入力と蓄積の自動記録』（みんみん）

入力フォームを作り、入力ボタンを押すと別シートのリストに蓄積されて入力フォームが初期化され、印刷ボタンを押すと別シートの様式が印刷される、というのを作成しています。

印刷はマクロの自動記録で出来たのですが、リストへの入力がうまくいきません。
ご指導のほどよろしくお願いします。

シートの内容はこんな感じです。

【入力フォーム】
　　　Ａ　　　Ｂ　　　　Ｃ　　　Ｄ　　　Ｅ　　Ｆ　　Ｇ
　　取扱店　受領者　　受付日　受付者
　林工務店　林　盛蔵　H25.5.22　みんみん

　　可燃ゴミ　　　　　　　　　　　　　　総額　５０，０００円
　　■大　　 購入枚数　５００枚
　　□中　　 購入枚数　　　　　
　　□小　　 購入枚数
　　不燃ゴミ
　　■大　　 購入枚数　５００枚
　　□中　　 購入枚数　　　　　　　　　　入　力
　　□小　　 購入枚数　　　　　　　　　　印　刷
　　資源ゴミ
　　■大　　 購入枚数　５００枚
　　□中　　 購入枚数　　　　　
　　□小　 　購入枚数
　　生ゴミ
　　■中　　 購入枚数　　５０枚
　　□小　　 購入枚数
　　
　　□粗大ｺﾞﾐ購入枚数

【リスト】　　
Ａ　　Ｂ　　　　　Ｃ　　　　　　　Ｄ　　　　　　　Ｅ　　　　　Ｆ　　　　　Ｇ　　　　　　Ｈ　　　　　　Ｉ　　　　Ｊ
�ａ@受付日　受付者　　　取扱店　　　受領者　可燃ゴミ　不燃ゴミ　資源ごみ　生ゴミ　粗大ゴミ
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　大中小　　大中小　　大中小　　中小
1　Ｈ25.5.22　みんみん　林工務店　林　盛蔵　500　　　　　500　　　　500　　　　　50

---

 とりあえず、作ったコードを、そのままアップしてみてはいかが？

 (ぶらっと)

---

（みんみん）

これです。
これでは入力フォームのチェックも外れないし、同じところに反映されるだけで蓄積されないんです。

Sub 入力()
'
' 入力 Macro
' マクロ記録日 : 2013/5/22 ユーザー名 : minmin
'

'

    Range("C2:D2").Select
    Selection.Copy
    Sheets("リスト").Select
    Range("B5:C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("A2:B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("D5:E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("I5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("J5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("L5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("M5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("N5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("O5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("P5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("リスト").Select
    Range("Q5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("入力").Select
    Range("C7:C22").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A2:B2,D2").Select
    Range("D2").Activate
    Selection.ClearContents
End Sub

（みんみん）

---

自動記憶じゃ無理ありますか(´д｀;

（みんみん）

---

    Sheets("リスト").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
こうなっていたら、Sheets("リスト")のRange("F5").Selectにしか値貼り付けできませんものね。
　
F列最終行直下の空白行へ貼り付けなら
    Sheets("リスト").Cells(Rows.Count , 6).End(xlUp).Offset( 1 ,0). _
        PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
　
ただし、１セルずつ処理するとよく似たコードの繰り返しになるので、
私ならシートのあいたところに一行になるように参照して、
それをコピー、Sheets("リスト")へ貼り付け、という処理にして、一回で済ませます。
　
チェックボックスはリンクさせるセルを作っておいて、
そのセルの値を変更するのが最初のうちは簡単でしょうか。
　　
ちなみに、「大中小」をSheets("リスト")に反映する部分がありませんけど、
どうするんですかね。
（みやほりん）

---

 ＞同じところに反映されるだけで蓄積されないんです。
 みやほりんさんのご指摘がありますが　常に5行目に貼りつけるコードになっている様なので
 先に5行目を挿入しておいて（←このコードを追加）
 現在の貼付作業をすると、新しいものが上に挿入されて蓄積される様になると思います。

 これなら、５行目だけを相手にすれば良いので、記録も簡単に取れると思います。

 表の最後に追加していきたい場合は、
 　シートの一番下のセルを選択
 　Ctrl + ↑　で入力がある最後のセルに移動して
 　【相対参照で記録】に切り替えて
 　↓　で一つ下のセルに移動
 したセルに貼りつける様にすると、マクロの記録だけでも出来ると思います。

 この場合、未入力のセルがあると　入力がある最後のセルと、新しいデータを書き込むセルが
 不一致になりますので、もう少し対応が必要になってきますが。

 私も
 ＞私ならシートのあいたところに一行になるように参照して、
 ってすると思います。
 コードも短くて済みますし、貼り付けるセルも一つだけ指定すれば良いですしね。

 ＞自動記憶じゃ無理ありますか
 と言う事なので、「できますよ」の意図で書いています。

 実際は、記録で出来た物を少しずつ変更しながら　使ってもらうと良いと思います。

 (HANA)

---

 位置関係が不明な点が多いのですが、提示されたコードを整理して見ると、Sub 入力A()　の様になります。
 つまり、記入位置が、常に 5 行目と指定されているので、データは追加記入されません。

 リストシートの、最終行の次の行番号 n を求め、記入位置を変数で指定したものが、Sub 入力B()　となります。
 それをさらに少し整理して、Sub 入力C()  。
 テストはしていませんので悪しからず・・・。考え方の参考にして下さい。

 Sub 入力A()
   With Sheets("入力")
      Sheets("リスト").Range("B5:C5").Value = .Range("C2:D2").Value '受付日,受付者
      Sheets("リスト").Range("D5:E5").Value = .Range("A2:B2").Value '取扱店,受領者
      Sheets("リスト").Range("F5:H5").Value = WorksheetFunction.Transpose(.Range("C7:C9").Value) '可燃ゴミ
      Sheets("リスト").Range("I5:K5").Value = WorksheetFunction.Transpose(.Range("C11:C13").Value) '不燃ゴミ
      Sheets("リスト").Range("L5:N5").Value = WorksheetFunction.Transpose(.Range("C15:C17").Value) '資源ゴミ
      Sheets("リスト").Range("O5:P5").Value = WorksheetFunction.Transpose(.Range("C19:C20").Value) '生ゴミ
      Sheets("リスト").Range("Q5").Value = .Range("C22").Value '粗大ゴミ
      .Range("A2:B2,D2,C7:C22").ClearContents
   End With
 End Sub

 Sub 入力B()
   Dim n As Long
      n = Sheets("リスト").Cells(Rows.Count, "b").End(xlUp).Row + 1 'B列最終行の下
      If n < 5 Then n = 5
      With Sheets("入力")
         Sheets("リスト").Range("B" & n & ":C" & n).Value = .Range("C2:D2").Value '受付日,受付者
         Sheets("リスト").Range("D" & n & ":E" & n).Value = .Range("A2:B2").Value  '取扱店,受領者
         Sheets("リスト").Range("F" & n & ":H" & n).Value = WorksheetFunction.Transpose(.Range("C7:C9").Value) '可燃ゴミ
         Sheets("リスト").Range("I" & n & ":K" & n).Value = WorksheetFunction.Transpose(.Range("C11:C13").Value) '不燃ゴミ
         Sheets("リスト").Range("L" & n & ":N" & n).Value = WorksheetFunction.Transpose(.Range("C15:C17").Value) '資源ゴミ
         Sheets("リスト").Range("O" & n & ":P" & n).Value = WorksheetFunction.Transpose(.Range("C19:C20").Value) '生ゴミ
         Sheets("リスト").Range("Q" & n).Value = .Range("C22").Value '粗大ゴミ
         .Range("A2:B2,D2,C7:C22").ClearContents
      End With
 End Sub

 Sub 入力C()
   Dim n As Long
      n = Sheets("リスト").Cells(Rows.Count, "b").End(xlUp).Row + 1 'B列最終行の下
      If n < 5 Then n = 5
      With Sheets("入力")
         Sheets("リスト").Range("B" & n).Resize(, 2).Value = .Range("C2:D2").Value '受付日,受付者
         Sheets("リスト").Range("D" & n).Resize(, 2).Value = .Range("A2:B2").Value '取扱店,受領者
         Sheets("リスト").Range("F" & n).Resize(, 3).Value = WorksheetFunction.Transpose(.Range("C7:C9").Value) '可燃ゴミ
         Sheets("リスト").Range("I" & n).Resize(, 3).Value = WorksheetFunction.Transpose(.Range("C11:C13").Value) '不燃ゴミ
         Sheets("リスト").Range("L" & n).Resize(, 3).Value = WorksheetFunction.Transpose(.Range("C15:C17").Value) '資源ゴミ
         Sheets("リスト").Range("O" & n).Resize(, 2).Value = WorksheetFunction.Transpose(.Range("C19:C20").Value) '生ゴミ
         Sheets("リスト").Range("Q" & n).Value = .Range("C22").Value '粗大ゴミ
         .Range("A2:B2,D2,C7:C22").ClearContents
      End With
 End Sub
 (暇人)

---

ありがとうございます。
うまくいきました。
ここを見ながらどーにかできないかやってましたが、うまい事いかず困ってました(^^;
http://www.excel.studio-kazu.jp/kw/20040720114929.html

あともう1つ質問なんですが、チェックボックスもリセットしたいのですが単純に下記の分を下に貼り付ければできますか？

Range("I7:I22").Select

    Selection.ClearContents
    Range("A2").Select

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

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