色彩検定1級を取得する魅力を紹介♪

とある入力用シートをまとめて別シートに全て毎回手で入力しているのですが、
入力したデータを別シートの雛形に蓄積するという方法はありますでしょうか。
コピペというのも考えましたが、入力用シート自体はシートごとで保存していたら
膨大な量になってしまうので上書きで作成しているためコピペが出来ません。

例えば、
入力用シートにA22〜F22(日付や数・単価・金額(金額は数式入っています))を入力したら
蓄積用シートのA22〜F22にデータが反映され、
それが新たに入力用シートの同じ箇所(A22〜F22)に入力しても
蓄積用シートのA22〜F22以降の行に反映し蓄積出来るようにしたいです。

また、月ごとに蓄積用シートを変えれれば尚良いと思っています。

調べていたら関数では出来ないとのこと&今まで同様の質問をされていた内容を試して見たが出来なかったです。
マクロに挑戦してみようと思うのですが、全くの初心者です。

エクセルのバージョンは2016です。
方法がなければ諦めます。方法があればお教えください。
よろしくおねがいします。

質問者からの補足コメント

  • No.3・4様
    お返事が遅くなり申し訳ございません。
    No.4で試して見ます!念のため質問に答えておきます。
    ① 入力用シートですが、F列以降は何か入力されていますか?
    →されております。
    ② 多分ですが入力後右のセルに移るように設定されていると思いますが間違いないでしょうか?
    →設定されております。
    ③ 日付はどこに記入されていますか?
    →A22セルから下に入力されております。
    ④ 計算式はどこに入っていますか?
    DとEをかけてFに合計です。
    ⑤ 入力後クリアした方が使いやすいと思うのですが、クリアしない方が良いところはありますか?
    →入力用シートに入力した後はまた新たにクリアします。

      補足日時:2019/10/21 17:59
gooドクター

A 回答 (9件)

「Cells(Target.Row, 6).FormulaR1C1 = "=RC[-2]*RC[-1]"」は


「Cells(Target.Row, 6).FormulaR1C1 = "=IF(OR(RC[-2]="""",RC[-1]=""""),"""",RC[-2]*RC[-1])"」
の方が良いかもです。
    • good
    • 0
この回答へのお礼

何件もご回答頂きありがとうございます!
試してみます(^^)

お礼日時:2019/11/08 15:34

こんなものはいかがでしょうか?


① 印刷が終わると「データの転記とクリアを行いますか?」の確認が有ります「はい」ボタンを押すと先に進みます。「いいえ」ボタンを押すとキャンセルになり何もしないで終了します(印刷プレビューでの誤動作の後処理用)
② 現在存在するシートの名前を辞書に登録
③ 入力用シートの22行目からのA列の日付を基に年月(シート名)を作成
④ ③で作成したものが辞書に無かったら、辞書に登録後、シートを追加しシート名を年月に変える、入力用シートをコピぺして22行目以降のA~F列をクリア成しておきます(22行目以降のA~F列以外は書式を含めて残ります)
⑤ ③~④を最後まで繰り返します(これで必要なシートが揃います)
⑥ 一度辞書をクリアします
⑦ 入力用シートの22行目からのA列の日付を基に年月(シート名)を作成(データにあるシート名だけのリストを作成します)
⑧ ⑦で作成したものが辞書に無かったら、年月日シートに入力用シートの22行目以降のA~F列を追加コピーします。年月と合わない行のA~Fのデータをクリア、あっている場合は念のためF列を再計算しておき、22行目以降をA列を基にソートを行い、その後不要な部分を削除します。
⑨ ⑦~⑧を最後まで繰り返します。
⑩ 入力用シートのデータをクリアします。(保存データ重複防止です)

--------------------------------------------------------------------------------------
☆「入力用」へ (注:①)
  これでD列とE列に何か入力されるとF列に計算式がセットされるようになります。
--------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Row >= 22 Then
  If Target.Column >= 4 Then
   If Target.Column <= 5 Then
    Application.EnableEvents = False
    Cells(Target.Row, 6).FormulaR1C1 = "=RC[-2]*RC[-1]"
    Application.EnableEvents = True
   End If
  End If
 End If

End Sub
--------------------------------------------------------------------------------------
☆「ThisWorkbook」へ (注:②)
  これで印刷開始後「転記」のマクロが起動します 
--------------------------------------------------------------------------------------
Private Sub Workbook_BeforePrint(Cancel As Boolean)

 Application.OnTime Now(), "転記"

End Sub
--------------------------------------------------------------------------------------
☆「標準モジュール」へ (注:③)
--------------------------------------------------------------------------------------
Sub 転記()

Const 元シート名 As String = "入力用"
Dim シート辞書 As Object
Dim シート As Worksheet
Dim 終行番号 As Long
Dim 行番号 As Long
Dim 年月 As String
Dim 次行番号
Dim 次終行番号

 If MsgBox("データの転記とクリアを行いますか?", vbDefaultButton2 + vbYesNo) <> vbYes Then Exit Sub
 Sheets(元シート名).Select
 終行番号 = Cells(Rows.Count, 1).End(xlUp).Row
 If 終行番号 >= 22 Then
  Set シート辞書 = CreateObject("Scripting.Dictionary")
  For Each シート In Worksheets
   シート辞書.Add シート.Name, "元"
  Next
  For 行番号 = 22 To 終行番号
   年月 = Format(Cells(行番号, 1).Value, "yyyy_mm")
   If Not シート辞書.Exists(年月) Then
    シート辞書.Add 年月, "新"
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = 年月
    Sheets("入力用").Cells.Copy
    ActiveSheet.Paste
    Range(Cells(22, 1), Cells(終行番号, 6)).ClearContents
    Sheets(元シート名).Select
   End If
  Next
  シート辞書.RemoveAll
  For 行番号 = 22 To 終行番号
   年月 = Format(Cells(行番号, 1).Value, "yyyy_mm")
   If Not シート辞書.Exists(年月) Then
    シート辞書.Add 年月, "有"
    次行番号 = Sheets(年月).Cells(Rows.Count, 1).End(xlUp).Row + 1
    If 次行番号 < 22 Then 次行番号 = 22
    Range(Cells(22, 1), Cells(終行番号, 6)).Copy Sheets(年月).Cells(次行番号, 1)
    Sheets(年月).Select
    Do While IsDate(Cells(次行番号, 1).Value)
     If 年月 <> Format(Cells(次行番号, 1).Value, "yyyy_mm") Then
      Range(Cells(次行番号, 1), Cells(次行番号, 6)).ClearContents
     End If
     次行番号 = 次行番号 + 1
    Loop
    Range("A22:F" & 次行番号).Sort Key1:=Range("A22"), Order1:=xlAscending, Header:=xlNo
    次行番号 = Cells(Rows.Count, 1).End(xlUp).Row
    Rows(次行番号 & ":" & Rows.Count).Delete Shift:=xlUp
    Cells(次行番号, 1).Select
    Range("A1") = "請求書(蓄積用)"
    次行番号 = ActiveSheet.UsedRange.Row
    Sheets(元シート名).Select
   End If
  Next
  Range(Cells(22, 1), Cells(終行番号, 6)).ClearContents
  Range("A22").Select
  次行番号 = ActiveSheet.UsedRange.Row
  Set シート辞書 = Nothing
  MsgBox ("終了しました")
 Else
  MsgBox ("データが有りませんでした")
 End If

End Sub
--------------------------------------------------------------------------------------
※(注:)は、図を参照してください。
※ F列目には計算式が入っている可能性が有るため、行の最後の判断材料にならなかったのでA列を使用しています。
  (日付が無いデータはどこのシートに転写して良いか判らないので削除してます)
※「Const …」の「=」の右側は環境に合わせて変更して下さい。
「エクセルで入力シートから別シートに蓄積方」の回答画像8
    • good
    • 1
この回答へのお礼

詳しくありがとうございます!!
初めてなので出来るかわからないですが、試してみます!
ご丁寧に何度もありがとうございます(T ^ T)!

お礼日時:2019/10/24 14:51

No.5 のお礼について



③ 行の最後はF列で判断すれば良いという事でしょうか?またF列で「空行」の判断をしても良いですか?
④⑤ それでしたら印刷したタイミングでの転記の方が間違いないと思いますがいかがでしょうか?
⑥ 題名とはどこのセルに入っているのですか?もしかしたら印刷時のヘッダーでしょうか?
    • good
    • 1
この回答へのお礼

③ 行の最後はF列で判断すれば良いという事でしょうか?またF列で「空行」の判断をしても良いですか?
F列に金額の合計が書いてあるという感じです。
④⑤ それでしたら印刷したタイミングでの転記の方が間違いないと思いますがいかがでしょうか?
印刷のタイミングで転記で構いません!
⑥ 題名とはどこのセルに入っているのですか?もしかしたら印刷時のヘッダーでしょうか?
印刷時のヘッダーではなくA1(AからEの列がセルの統合されています。)です。

よろしくお願いいたします。

お礼日時:2019/10/23 14:27

こんなものはいかがでしょうか?


① 現在存在するシートの名前を辞書に登録
② 入力用シートの22行目からのA列の日付を基に年月(シート名)を作成
③ ②で作成したものが辞書に無かったら入力用シートをコピーしてシート名を年月に変えて22行目以降のA~F列を削除して空シートを作成しておきます(22行目以降のA~F列以外は書式を含めて残ります)
④ ②~③を最後まで繰り返します(これで必要なシートが揃います)
⑤ 一度辞書をクリアします
⑥ 入力用シートの22行目からのA列の日付を基に年月(シート名)を作成
⑦ ⑥で作成したものが辞書に無かったら、年月日シートに入力用シートの22行目以降のA~F列をコピーします。年月と合わない行のA~Fのデータをクリア、あっている場合は念のためF列を再計算しておき、22行目以降をA列を基にソートを行い、その後不要な部分を削除します。
⑧ ⑥~⑦を最後まで繰り返します。
⑨ 入力用シートのデータをクリアします。(保存データ重複防止です)

Sub Sample()

Const 元シート名 As String = "入力用"

Dim シート辞書 As Object
Dim シート As Worksheet
Dim 終行番号 As Long
Dim 行番号 As Long
Dim 追行番号 As Long
Dim 年月 As String
Dim 次行番号 As Long
Dim 次終行番号 As Long

 Sheets(元シート名).Select
 終行番号 = Cells(Rows.Count, 1).End(xlUp).Row
 If 終行番号 >= 22 Then
  Set シート辞書 = CreateObject("Scripting.Dictionary")
  For Each シート In Worksheets
   シート辞書.Add シート.Name, "元"
  Next
  For 行番号 = 22 To 終行番号
   年月 = Format(Cells(行番号, 1).Value, "yyyy_mm")
   If Not シート辞書.Exists(年月) Then
    シート辞書.Add 年月, "新"
    Sheets(元シート名).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = 年月
    Range(Cells(22, 1), Cells(Rows.Count, 6)).Delete Shift:=xlUp
    Sheets(元シート名).Select
   End If
  Next
  シート辞書.RemoveAll
  For 行番号 = 22 To 終行番号
   年月 = Format(Cells(行番号, 1).Value, "yyyy_mm")
   If Not シート辞書.Exists(年月) Then
    シート辞書.Add 年月, "有"
    次行番号 = Sheets(年月).Cells(Rows.Count, 1).End(xlUp).Row + 1
    If 次行番号 < 22 Then 次行番号 = 22
    Range(Cells(22, 1), Cells(終行番号, 6)).Copy Sheets(年月).Cells(次行番号, 1)
    Sheets(年月).Select
    次終行番号 = Cells(Rows.Count, 1).End(xlUp).Row
    For 追行番号 = 次行番号 To 次終行番号
     If 年月 = Format(Cells(追行番号, 1).Value, "yyyy_mm") Then
      Cells(追行番号, 6).Value = Cells(追行番号, 4).Value * Cells(追行番号, 5).Value
     Else
      Range(Cells(追行番号, 1), Cells(追行番号, 6)).ClearContents
     End If
    Next
    Range("A22:F" & 追行番号).Sort Key1:=Range("A22"), Order1:=xlAscending, Header:=xlNo
    次行番号 = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Rows(次行番号 & ":" & Rows.Count).Delete Shift:=xlUp
    Cells(次行番号, 1).Select
    次行番号 = ActiveSheet.UsedRange.Row
    Sheets(元シート名).Select
   End If
  Next
  Range(Cells(22, 1), Cells(終行番号, 5)).ClearContents
  Range("A22").Select
  Set シート辞書 = Nothing
  MsgBox ("終了しました")
 Else
  MsgBox ("データが有りませんでした")
 End If

End Sub

※ シートは見つかった順に作成するので順番には並びません、必要ならば手動で入れ替えて下さい。
※ 自動では実行されません
※ 元シート名の「入力用」は状況に合わせて下さい。
※ 転送先のシート名は「yyyy_mm」にしています。
    • good
    • 0

なんとなく理解しました。


22行目だけに入力されるわけではなく、その下の行に何行か入力していくわけですね?
(提案してしまったのは22行目にだけに入力して、入力したらすぐ転記してしまうものです)
改めての確認です。
① 何行目まで入力できるとかの制限はありますか?
② 途中入力しない(空行)は存在しますか?もしあった場合は飛ばせば良いのですか?
③ 必ず入力される列はどこですか?(全てならそう回答ください)
④ 転記するタイミングは「保存」処理をしたときで良いですか?
⑤ 転記したらクリアして良いですよね?(転記した物が重複されないように)
⑥ 転記先も22行目からとなっていますが、21行目までも1度目はコピーした方が良いのでしょうか?
⑦ 転送先のシート名は「yyyy_mm」で良いですか?
    • good
    • 1
この回答へのお礼

① 何行目まで入力できるとかの制限はありますか?
特に制限はありません。
② 途中入力しない(空行)は存在しますか?もしあった場合は飛ばせば良いのですか?
空行は存在しますが、飛ばせば大丈夫です。
③ 必ず入力される列はどこですか?(全てならそう回答ください)
F22〜F32あたりまでは入力します。
④ 転記するタイミングは「保存」処理をしたときで良いですか?
保存するタイミングで大丈夫です。
⑤ 転記したらクリアして良いですよね?(転記した物が重複されないように)
クリアする前に印刷をかけますが、印刷後はクリアで大丈夫です。
⑥ 転記先も22行目からとなっていますが、21行目までも1度目はコピーした方が良いのでしょうか?
コピーしますが、題名を納品書(入力用シート)→請求書(蓄積用)に変更したいです。
⑦ 転送先のシート名は「yyyy_mm」で良いですか?
大丈夫です。

お礼日時:2019/10/23 13:35

No.3 に対する返答が無かったので図の様な物を考えました。


次のようにしてお試しでテストしてみて下さい。

新規にブックを作成してシートを「入力用」だけにして「○○.xlsm」で保存して下さい。

図を参考に他の書式などもここで設定しておいてください。
[Enter]後のセル移動は「右」にして下さい
ちなみに G22セルはボタン風に見せる為、灰色の背景色、右と下に太い罫線引いておきます。
(判りやすくしているだけなので必ずしもこうでなくても構いません)
ここまでで一度保存しておきます。

「入力用」シートの「Worksheet_SelectionChange」に次のコードをコピペして下さい

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 If Target.Address = "$G$22" Then
  If IsDate(Range("A22").Value) Then
   Call 転写処理(Range("A22").Value)
  End If
 End If

End Sub

「標準モジュール」に次のコードをコピペして下さい

Sub 転写処理(日付 As Date)

Dim シート名 As String
Dim シート As Worksheet
Dim シート有 As Boolean
Dim 次行 As Long

 シート名 = Format(日付, "yyyy_mm")
 For Each シート In Worksheets
  If シート.Name = シート名 Then シート有 = True
 Next
 If シート有 Then
  Sheets(シート名).Select
 Else
  Worksheets.Add(After:=Worksheets(1)).Name = シート名
  Sheets("入力用").Range("A21:F21").Copy Range("A1")
 End If
 次行 = Cells(Rows.Count, 1).End(xlUp).Row + 1
 Sheets("入力用").Range("A22:F22").Copy
 Cells(次行, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
 Cells(次行, 1).PasteSpecial Paste:=xlPasteValues
 Cells.EntireColumn.AutoFit
 Sheets("入力用").Select
 Range("A22:E22").ClearContents
 Range("A22").Select

End Sub

ここで保存をして下さい。(後はご自由に…)

☆ 使い方

A22 ~ E22 まで入力し[Enter]キーで金額欄に移ります。
ここで入力に間違いがないか確認して下さい。
間違いが無ければ[Enter]キーで G22セルに移ると転写され A22~E22 がクリアされ A22 に移ります。
間違いが有った場合は修正後、数回[Enter]キーを押し G22セルまでもっていけば転写されます。
マウスなどの作業が不要でとても効率よいものになると思います。
(G22 セルを選択しても A22 セルに日付が無ければ転写は行われません)
「エクセルで入力シートから別シートに蓄積方」の回答画像4
    • good
    • 1
この回答へのお礼

質問の回答が遅くなってしまい、申し訳ございません。
ご丁寧に解説くださりありがとうございます。試してみます!

お礼日時:2019/10/21 18:02

幾つか確認させてください。


① 入力用シートですが、F列以降は何か入力されていますか?
② 多分ですが入力後右のセルに移るように設定されていると思いますが間違いないでしょうか?
③ 日付はどこに記入されていますか?
④ 計算式はどこに入っていますか?
⑤ 入力後クリアした方が使いやすいと思うのですが、クリアしない方が良いところはありますか?
    • good
    • 1

こんばんは!



一例です。
標準モジュールにしてください。

Sub Sample1()
 Dim myRow As Long
 Dim wS As Worksheet

  Set wS = Worksheets("蓄積用")
   If wS.Cells(Rows.Count, "A").End(xlUp).Row < 22 Then
    myRow = 22
   Else
    myRow = wS.Cells(Rows.Count, "A").End(xlUp).Row + 1
   End If
   With Worksheets("入力用").Range("A22").Resize(, 6)
    .Copy
    wS.Cells(myRow, "A").PasteSpecial Paste:=xlPasteValues
    .SpecialCells(xlCellTypeConstants).ClearContents '//★//
   End With
End Sub

※ 「入力用」シートのA22~F22を入力後マクロを実行してください。
※ 値の貼り付けにしていますので、「蓄積用」シートの日付列の表示形式は好みの表示形式にしておいてください。
※ 「入力用」シートのA22~F22のデータはコピー&ペースト後、
数式が入っていないセルを消去するようにしています。
そのままデータを残したい場合は「★」の行を削除してください。

>また、月ごとに蓄積用シートを変えれれば尚良いと思っています。
というコトですが同一ブック内に同一シート名を付けるコトはできませんので、
「蓄積用」シートのシート名を月によって変更する必要があります。m(_ _)m
    • good
    • 1
この回答へのお礼

ご丁寧にありがとうございます!
試してみます!

お礼日時:2019/10/21 18:01

「フォーム」機能ではいかがですか?


http://excel.resocia.jp/report/2029/
  
突き詰めればAccessの方が適していると思えますが、Accessは取り付きにくい。
    • good
    • 1
この回答へのお礼

ありがとうございます!内容を見てみたのですが、私の理想とちょっと違いましたが、違う業務で活かせると思うので知識として頭に入れておきます!

お礼日時:2019/10/21 18:00

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング