[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『対応する日、場所にデータを転記』（上）
お世話になります。
一日にかかった経費をひと月毎に管理する表を作りたいです。
今あるレイアウトとしては
A列：日付(1日、2日…のみの表記)
B列以降：名前とかかった金額を行で分けている
A B C D E・・・ K L
1 見出し(平成28年〇月度経費)
2 空欄 月別合計欄
3 1日 名前 名前 名前 名前・・・
4 金額 金額 金額 金額・・・ 人別合計欄
5 2日 名前 名前 名前 名前・・・名前 合計金額
6 金額 金額 金額 金額・・・
↑分かりにくいですがこんな感じです
で、一か月の間に同じ人が何回も出てくる場合もあり 一か月間の合計と人毎の合計も端に列を作って出したいです。
たとえば 山田さんが 1日：￥1000 8日：￥2000 17日：￥1000 24日：￥1000
佐藤さんが 2日：￥1000 15日：￥2000
だとすると 合計欄に 「山田 ￥5000」 その山田さんの下に 「佐藤 ￥3000」 と表示したいです。
さらに、山田さんは月４回出てくるので
入力場所を設けてそこに 名前と日付(複数日数)、その日かかった金額を入力したら 対応する日付に一気に名前と金額を入力できたらいいなと思います。
今あるレイアウトが良くないなら変えたいですが 上記方法を実現させるにはどうしたらいいでしょうか…。
丸投げの質問ではありますが どなたか知恵をお貸しくださいm(__)m
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
日付 名前 金額 1日 Aさん 100 1日 Bさん 200 1日 Cさん 300
こんなレイアウトにしたらオートフィルタでいいんでない？ （GobGob） 2016/04/26(火) 15:36
こんな感じにしたらどうでしょうか？
<当月>シート 反映前 行 __A__ ____B____ ____C____ _D_ __E__ __F__ _G_ _H_ ____I____ 1 反映可能 ←右Click 西暦 2016 年 4 月度経費 2 氏名 日付 金額 3 山田 1 101 4 3 1,002 5 4 10,004 6
11 12 月合計 13 14 人名別 合計金額
<当月>シート B1セルを右クリックして、入力情報を表に反映させた後 行 __A__ ____B____ ____C____ _D_ __E__ ___F___ _G_ _H_ ____I____ 1 入力待ち 西暦 2016 年 4 月度経費 2 氏名 日付 金額 3 1(金) 山田 4 101 5 6 7 3(日) 山田 8 1002 9 4(月) 山田 10 10,004 11 12 月合計 11,107 13 14 人名別 合計金額 15 山田 11,107
手順 １．新規ブックに1枚シートを挿入して、「当月」と言うシート名にする。 そのシートタブを右クリックして、コードの表示を選択してＶＢＥ画面に行く。 下のコートを貼り付けて、F5キーを押下して「OnlyOnce」マクロを実行する
Private Sub onlyOnce() ’当月シートのスケルトンを作成する
Rem 生データのセルをまとめて処理
Range("E1").Value = "西暦"
Range("G1").Value = "年"
Range("I1").Value = "月度経費"
Range("A2").Value = "氏名"
Range("B2").Value = "日付"
Range("C2").Value = "金額"
Range("B12").Value = "月合計"
Range("B14").Value = "人名別"
Range("C14").Value = "合計金額"
Rem 数式セルをまとめて処理
Range("B1").FormulaR1C1Local = "=IF(AND(SUMPRODUCT(N((R[2]C:R[9]C="""")+(R[2]C[1]:R[9]C[1]="""")=1))=0,COUNTA(RC[4],RC[6],R[2]C[-1],R[2]C,R[2]C[1])=5),""反映可能"",""入力待ち"")"
Range("C1").FormulaR1C1Local = "=IF(RC[-1]=""反映可能"",""←右Click"","""")"
Rem 標準外書式セルをまとめて処理
Range("C3:C7,C15:C500").NumberFormatLocal = "#,##0;[赤]-#,##0"
Rem 塗りつぶしセルをまとめて処理
Range("F1,H1,A3:C3,B4:C10").Interior.ColorIndex = 19
With Range("B1") '条件付き書式を設定する
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""反映可能"""
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10092441
End With
End With
End Sub
２．実行後は用済みとなるので、上のコードは削除し、 代わって、以下のコードを貼り付ける
(1)「当月」シートのシートモジュールに
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Rem 事前チェック
If Target.Address(0, 0) <> "B1" Then Exit Sub
If Target.Value <> "反映可能" Then Exit Sub
Cancel = True
Rem 転記・集計
CKnBooking
sumByName
End Sub
(2)標準モジュールに
Sub CKnBooking() '日付のチェックと転記
Dim NN As Long, TbRowNo As Long, TbColNo As Long, DTin, nameToProc
DTin = Range("B3:C10").Value
For NN = 1 To UBound(DTin)
If DTin(NN, 1) <> "" Then
If DTin(NN, 1) < 1 Or DTin(NN, 1) > [DAY(DATE(F1,H1+1,0))] Then
MsgBox "日付が当月の範囲外です。処理中止"
Exit Sub
End If
End If
Next
Rem 書き込み
nameToProc = Range("A3").Value
For NN = 1 To UBound(DTin)
If DTin(NN, 1) <> "" Then
TbRowNo = DTin(NN, 1) * 2 + 1
TbColNo = Cells(TbRowNo, 500).End(xlToLeft).Column
If TbColNo < 5 Then
TbColNo = 5
Cells(TbRowNo, 5).Value = Format(DateSerial([F1], [H1], DTin(NN, 1)), "d(aaa)")
End If
Cells(TbRowNo, TbColNo + 1) = nameToProc
Cells(TbRowNo + 1, TbColNo + 1) = DTin(NN, 2)
End If
Next
If MsgBox("転記完了。入力データをクリアしますか？", vbYesNo) = vbYes Then
Range("A3:C10").ClearContents
End If
End Sub
Sub sumByName() '合計算出
Dim DTin, dicT As Object
Dim TbRowNo As Long, TbColNo As Long
Dim MaxRow As Long, MaxCol As Long
Set dicT = CreateObject("Scripting.Dictionary")
MaxRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
MaxCol = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
DTin = Range("F3", Cells(MaxRow, MaxCol)).Value
For TbRowNo = 1 To UBound(DTin) Step 2
For TbColNo = 1 To UBound(DTin, 2)
If DTin(TbRowNo, TbColNo) <> "" Then
If dicT.exists(DTin(TbRowNo, TbColNo)) Then
dicT(DTin(TbRowNo, TbColNo)) = dicT(DTin(TbRowNo, TbColNo)) + DTin(TbRowNo + 1, TbColNo)
Else
dicT.Add DTin(TbRowNo, TbColNo), DTin(TbRowNo + 1, TbColNo)
End If
End If
Next TbColNo
Next TbRowNo
Range("B15:C500").ClearContents
Range("B15").Resize(dicT.Count, 1).Value = Application.Transpose(dicT.keys)
Range("C15").Resize(dicT.Count, 1).Value = Application.Transpose(dicT.items)
Range("C12").Value = Application.Sum(Range("C15:C500"))
End Sub
３．運用を開始する (1)年と月を、F1セル、H1セルに入力する。 例：2016 と 4
(2)A3に氏名を入力する。
(3)B3:C10に、日付(ただの数値。シリアル値ではない）と金額を入力する。 10行目に収まらない場合は、次のルーティンで処理する(つまり、２回に分ける)
(4)所用データを入力後、B1セルを右クリックする (そのセルには「反映可能」と表示されている）
(5)「転記完了。入力データをクリアしますか？。」と訊かれたら、それに応える。 通常はYESをクリックして、クリアさせることになります。 データが多くて、2回に分ける場合は、NOをクリックして、名前データを生かすような運用になる。
(6)次の人の処理に移る。つまり、上記(2)に戻って繰り返す。
※当月処理が終わったら、このシートは引き続き「当月」となり続けるため 全データを別のシート(例：4月シート）にコピペ(値の貼り付け）する。
そして、「当月」シートは、スケルトン部分を残してクリアし、翌月の「当月」として再利用する。
（半平太） 2016/04/27(水) 09:41
ご回答ありがとうございます。
すごく良さそうな感じがするのですが
マクロの解読に時間がかかりそうなので
ちょっとがんばってみます＞＜
（上） 2016/04/27(水) 22:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.