[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シート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.