[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力データを別シートへ蓄積』（みなみ）
おはようございます。
現在、受け付けたデータを申請様式と申請者一覧に手入力しているのですが、入力シートに入力したものをリストシートへ蓄積、リストシートから様式に抽出して印刷という感じのものを作ろうと奮闘しています。
一覧から様式へはVLOOKUP等を使い抽出できるのですが、入力シートからリストへの蓄積がなかなかうまくいきません。
こちらの過去ログを見ながら作ってみたのですが、リストの一番上にコピーされた後はその下に蓄積されません。
どこがおかしいか教えていただけないでしょうか？
入力シートとリスト一覧はこんな感じです。
『入力シート』
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ
申請日 住所 氏名 種類 業者住所 業者名 期間 （Ａ）（Ｂ）（Ｃ）
『リストシート』
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ ｋ
番号 申請日 住所 氏名 種類 業者住所 業者名 期間 （Ａ）（Ｂ）（Ｃ）
入力シートは入力場所は別にあるのですが参照しやすいように参照用にリストと同じ表に飛ぶようにしています。
マクロはこんな感じです。
Sub 入力()
Dim n As Long
n = Sheets("入力・確認").Cells(Rows.Count, "B").End(xlUp).Row + 1 'B列最終行の下
If n < 4 Then n = 4
With Sheets("入力・確認")
Sheets("リスト").Range("B" & n).Resize(, 4).Value = .Range("A3:D3").Value '申請日,申請者
Sheets("リスト").Range("F" & n).Resize(, 2).Value = .Range("E3:F3").Value '施工業者
Sheets("リスト").Range("H" & n).Value = .Range("G3").Value '工事期間
Sheets("リスト").Range("I" & n).Resize(, 3).Value = .Range("H3:J3").Value '交付決定額(千円)
End With
End Sub
入力ボタンを押した後、リストに蓄積され入力画面はクリアしたいのですができるでしょうか？
リストに蓄積していきたいなら、「n」の値は、リストシートの最終行じゃないですか？
n = Sheets("入力・確認").Cells(Rows.Count, "B").End(xlUp).Row + 1 'B列最終行の下
~~~~~~~~~~~~~~
n = Sheets("リスト").Cells(Rows.Count, "B").End(xlUp).Row + 1 'B列最終行の下
クリアは
With Sheets("入力・確認")
.Range("A3:D3").clearcontents'申請日,申請者
end with
こんな感じでできるかと。
というか、 Sub 入力()
Dim dRng As Range
Dim n As Long
n = Sheets("リスト").Cells(Rows.Count, "B").End(xlUp).Row + 1 'B列最終行の下
If n < 4 Then n = 4
Set dRng = Sheets("入力・確認").Range("A3:J3")
Sheets("リスト").Range("B" & n).Resize(, dRng.Columns.Count) = dRng.Value
End Sub
ひとつずつ分けてリストに追加する必要あります？
（稲葉）
ひとつずつ分かれていたのは、参考にしたマクロをそのまま利用したためです。
あと、聞き方が悪かったのですが入力シートのクリアは参照用のセルのクリアではなく別の列にある入力用の表のクリアになります。
教えていただいたマクロを使ってみましたが、セルが飛び飛びな上、列の幅を1.0にして結合して表を使っているせいか、エラーになってしまいました。
ためしに自動記録で作ってみました。
Range( _
"U3:W3,Y3:AA3,AV2:AX2,BA2:BC2,BF2:BH2,S4:AK4,S6:AK7,S9:V9,X9:AA9,AC9:AF9,S14:AK14,V21:W21,Z21:AA21,AW14:AY14,BA14:BC14,AU15:BM15,AU17:BM17,AU19:AX20,AZ19:BC20,BE19:BH20,AR25:AT26,AW25:AY26,BB25:BD26" _
).Select
Range("BB25").Activate
ActiveWindow.SmallScroll Down:=18
Range( _
"U3:W3,Y3:AA3,AV2:AX2,BA2:BC2,BF2:BH2,S4:AK4,S6:AK7,S9:V9,X9:AA9,AC9:AF9,S14:AK14,V21:W21,Z21:AA21,AW14:AY14,BA14:BC14,AU15:BM15,AU17:BM17,AU19:AX20,AZ19:BC20,BE19:BH20,AR25:AT26,AW25:AY26,BB25:BD26,AQ31:AY38,AZ41:BH42" _
).Select
Range("AZ41").Activate
ActiveWindow.SmallScroll Down:=15
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-42
Range("U3:W3").Select
End Sub
うまくいきましたが、イメージはパッと一気に消える感じではないのでなんとなくモヤモヤ。。。
保護されていないセルをクリアするようにできれば一番いいのですが。。。
Dim dRng As Range
Dim r As Range
Dim n As Long
n = Sheets("リスト").Cells(Rows.Count, "B").End(xlUp).Row + 1 'B列最終行の下
If n < 4 Then n = 4
With Sheets("入力・確認")
Set dRng = .Range("A3:J3")
Sheets("リスト").Range("B" & n).Resize(, dRng.Columns.Count) = dRng.Value
Application.Calculation = xlManual '←手動計算に変更し、セルを消した時の再計算をさせない
For Each r In .Range("U3:BH42")
If Not r.Locked Then '保護されていないセルの時、値を消す
r.MergeArea.ClearContents '結合セルの場合、結合セル範囲に置き換えて削除
End If
Next
Application.Calculation = xlAutomatic '←自動計算に戻す
End With
End Sub
こんな感じでいかがでしょう？ ちょっとテスト出来てないけど、大丈夫なはず・・・ （念のため、バックアップ取ってから実行してみてください）
11:45追記 （稲葉）
このリストから申請月で別シートのリストと同じ様式に抽出するにはどうすればよろしいでしょうか？
=IF(B4="","",TEXT(B4,"geemm")&TEXT(COUNTIF(B$1:$B4,"<"&DATE(YEAR(B4),MONTH(B4)+1,1))-COUNTIF(B$1:$B4,"<="&(B4-DAY(B4))),"-00"))
こんな感じで申請日番号を作って
=IF($A6="","",VLOOKUP(TEXT($A$1,"gemm")&TEXT($A6,"-00"),リスト!$A:$Q,COLUMN(L6),FALSE))
こんなんで抽出できるみたいですが中身を理解できていないので全然うまくいきません(ToT)
（みなみ）
この質問って↓に続いてるんですかね？ [[20130627083141]]『リストから受付月ごとに抽出』（みなみ）
それとも、また別の話なんでしょうか。
(HANA)
質問してから反応が無かったので新しく質問してしまいました。
ごめんなさい。
（みなみ）
あ、ごめんなさいね どちらも私が関わった内容だ。
「すべてうまくいきました」を読んで、自分の中で終りになってました。 こちらは続けず、HANAさんが提示してくれたスレッドで続けてよろしいですね？ （稲葉）
（みなみ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.