[[20090224132033]] 『シート1からシート2に条件つきで自動に反映させた』(sasasachi) >>BOT

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

 

『シート1からシート2に条件つきで自動に反映させたいです』(sasasachi)
  
やりたい事〉シート1に日付・科目・摘要・金額を毎日入力していきます。(科目はバラバラです。)
シート1に入力した科目情報で、シート2〜に作成した科目別元帳に、日付・金額・摘要を自動的に反映させたいのです。
例)シート1
A列 B列 C列
1/1 備品  ¥500(実際には¥入れてません)
1/3 保険  ¥1000
1/5 備品  ¥500  と入力したら、自動的に
シート2
A列 B列 C列
1/1  備品 ¥500
1/5  備品 ¥500  と入力される。ようにしたいです。
 
ご指導おねがいします。(出来れば、総会3/1には完成、印刷までしたいので急いでます)

 


 以前のコメントですが。
[[20081218145320]]『データを品名別に別シートに自動的に入力したい』(山田)

 書式も一緒にの場合はこちらを。
[[20090127164751]]『別シートのデータにセルの色を反映』(やま)

 (HANA)

 衝突。。。

 こんな感じでどうでしょうか。
元に戻せなくなりますので、Bookを複製してからお試し下さい。
(ROUGE)
'----
Sub test()
Dim tbl, i As Long, ii As Long, x, ws As Worksheet
tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 3).Value
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tbl, 1)
        If .Exists(tbl(i, 2)) Then
            x = .Item(tbl(i, 2))
            ReDim Preserve x(1 To 3, 1 To UBound(x, 2) + 1)
            For ii = 1 To 3
                x(ii, UBound(x, 2)) = tbl(i, ii)
            Next
            .Item(tbl(i, 2)) = x
        Else
            ReDim x(1 To 3, 1 To 1)
            For ii = 1 To 3
                x(ii, 1) = tbl(i, ii)
            Next
            .Add tbl(i, 2), x
        End If
    Next
    For Each ws In Sheets
        If ws.Name <> "Sheet1" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next
    For Each x In .Keys
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = x
        ws.Range("A1").Resize(UBound(.Item(x), 2), 3).Value = _
            Application.Transpose(.Item(x))
    Next
End With
End Sub


早い対応ありがとうございます(><)初心者なので、マクロ??などは苦手ですが、
コピー貼り付けで使用させていただきます。ありがとうございます。

コメント返信:

[ 一覧(最新更新順) ]


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