[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2枚シートからの抽出』(マツ)
こんばんは。宜しくお願いします。下記の2枚のシートから3枚目の抽出シートのように 表示したいのですが データ量も多く良い方法を教えてください。
1枚目【シート名 「帳票A」】 このシートは抽出シート「実績」のB列の分類は”売”になります。このシートはA〜ADまでデータははいっています。 A B C D E F G H I J K L M N O P Q Z AA AB AC 1 予定A 予定B 実績 差額 2 コード 名 繰 日 現・小 手 サ 繰 日 現・小 手 サ 日 現・小 手 サ 現・小 手 現 手 3 12 あ 2,000 1,000 2,000 1,000 0 0 回収済 回収済 4 1 い 500 500 0 0 回収済 5 3 う 2,000 1,500 500 1,500 1,500 差額発生 未回収 6 45 え 2,000 2,000 2,000 500 0 1,500 回収済 差額発生 7 55 お 2,000 500 500 2,000 0 未回収 回収済 8 2 か 2,000 2,000 0 未回収
2枚目【シート名 「回収】 このシートは抽出シート「実績」のB列の分類は”前”になります。 A B C D E F G H I J K L 1 コード 名 日 現 手 実績現 実績手 差現 差手 現 手 2 11 た 2,200 1,000 2,200 0 0 1,000 未収 3 25 ち 1,500 0 0 0 1,500 0 未収 4 33 つ 1,500 500 0 500 1,500 0 未収 5 15 て 2,200 0 2,200 0 0 0 6 45 と 1,500 0 0 0 1,500 0 未収 7 32 な 0 1,000 0 1,000 0 0 8 18 は 0
3枚目【抽出シート 「実績」】 A B C D E F G H I J K L M N O 1 コード 分類 名 予定B 回収 未収 予定 変更日 再 再々 回収日 2 55 売 お 2,000 0 2,000 3 2 売 か 2,000 0 2,000 4 11 前 た 1,000 0 1,000 5 25 前 ち 1,500 0 1,500 6 33 前 つ 1,500 0 1,500 7 45 前 と 1,500 0 1,500
とりあえず。
Sub test()
Worksheets("実績").Select
Cells.Delete Shift:=xlUp
With Worksheets("実績")
.Cells(1, 1).Select
.Cells(1, 1) = "コード"
.Cells(1, 2) = "分類"
.Cells(1, 3) = "名"
.Cells(1, 6) = "予定B"
.Cells(1, 7) = "回収"
.Cells(1, 8) = "未収"
.Cells(1, 9) = "予定"
.Cells(1, 11) = "変更日"
.Cells(1, 12) = "再"
.Cells(1, 13) = "再々"
.Cells(1, 14) = "回収日"
End With
Dim a, n As Long
n = 1
With Worksheets("実績")
For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row
If Sheets("帳票A").Cells(d, 29).Value = "未回収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 4).Value
.Cells(n, 6).Value = Sheets("帳票A").Cells(a, 27).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next a
For a = 2 To Sheets("回収").Cells(65536, 2).End(xlUp).Row
If Sheets("回収").Cells(d, 11).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).Value = Sheets("回収").Cells(a, 9).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
If Sheets("回収").Cells(d, 12).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).Value = Sheets("回収").Cells(a, 10).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next a
End With
End Sub
計算式の定義とか、よく分かってないので違うかも。 (ken)
ありがとうございます。”実績”シートの標準モジュールに貼り付けましたが インデックスが 有効範囲にありませんとなります。 デバックをはいとすると a For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row と黄色でマーカされています。
マクロがわからないので 申し訳ないです。よろしくお願いします。
>a For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row と黄色でマーカされています。
もし、コレが入力間違いで無いとするならば
For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row
かな?
頭の a が何処からかついっちゃったのかな?
後は、このコードに書いてある変数が少しおかしいかも。。。
>If Sheets("帳票A").Cells(d, 29).Value = "未回収" Then
>If Sheets("回収").Cells(d, 11).Value = "未収" Then
>If Sheets("回収").Cells(d, 12).Value = "未収" Then
計3箇所の、
Cells(d,○) → Cells(a,○)
に変更してみてください。
※kenさん、突っ込みゴメンね〜mm
(キリキ)(〃⌒o⌒)b
ありがとうございます。
>For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row
a の部分直しました。すみません。。
>計3箇所の、Cells(d,○) → Cells(a,○) (a, ○) にしてみました。
インデックスが 有効範囲にありませんとなります。すみませんよろしくおねがいします。
シート名は合ってますか? 帳票A? 帳票A? 実際のシート名に合わせてみてください。
(キリキ)(〃⌒o⌒)b
それから 教えて頂いた下記マクロですると 1つのシートしか抽出できないようです。抽出できたのは 回収シートです。すみません。。よろしくお願いします。。
Sub test()
Worksheets("実績").Select
Cells.Delete Shift:=xlUp
With Worksheets("実績")
.Cells(1, 1).Select
.Cells(1, 1) = "コード"
.Cells(1, 2) = "分類"
.Cells(1, 3) = "名"
.Cells(1, 6) = "予定B"
.Cells(1, 7) = "回収"
.Cells(1, 8) = "未収"
.Cells(1, 9) = "予定"
.Cells(1, 11) = "変更日"
.Cells(1, 12) = "再"
.Cells(1, 13) = "再々"
.Cells(1, 14) = "回収日"
End With
Dim a, n As Long
n = 1
With Worksheets("実績")
For a = 3 To Sheets("帳票A").Cells(65536, 3).End(xlUp).Row
If Sheets("帳票A").Cells(a, 29).Value = "未回収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 4).Value
.Cells(n, 6).Value = Sheets("帳票A").Cells(a, 27).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next a
For a = 2 To Sheets("回収").Cells(65536, 2).End(xlUp).Row
If Sheets("回収").Cells(a, 11).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).Value = Sheets("回収").Cells(a, 9).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
If Sheets("回収").Cells(a, 12).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).Value = Sheets("回収").Cells(a, 10).Value
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next a
End With
(キリキ) さん、フォローありがとうございます。
>このコードに書いてある変数が少しおかしいかも 実は、変数をたくさん定義してしまい、見苦しかったので、このページ上で変更してたら・・・間違えてましたか。。。申し訳ありません。
>1つのシートしか抽出できないようです あれ?帳票Aのシート、抽出できないですか?帳票AのシートのAC列が"未収入"のときには、抽出されるはずですが・・・
気になってたんですが、差額発生時は、抽出不要?
(ken)
ごめんなさい。 抽出できました。本当に ありがとうございます。
すみません。最初から何度か やり直してみるとできました。 とても うれしいです。感謝です。
それから すみませんが また新たに教えてほしいのですが 先ほどのすごいマクロで抽出した ”実績”シートを確認して P列に必要事項を手入力するようにしたいと思います。そして ”手形”→”手形シート”のB5に ”1日”→”1日シート”B5にデータが行くように できれば とてもありがたいのですが よろしくお願いします。
>気になってたんですが、差額発生時は、抽出不要?
ありがとうございます。差額発生 忘れてました。
”帳票のシート”で セルAC・AD列が差額発生の場合 ”実績シート”に未回収と同じように一旦表示させたいです。その時 差額発生とO列に表示できれば嬉しいのですが、本当すみません。それから 確認して P列に 調整と入力すると→予定調整シートのB5に行くようにできれば ありがたいです。別シートに行ったデータは”実績シート”から削除されれば 助かります。
それから もしシートの開始セルを変更したい場合も できれば教えてほしいのですが お願いします。 ”帳票A”のシート 現在 C3 → B9に ”回収”のシート 現在 A2 → A7に ”実績”のシート 現在 A2 → A6に よろしく おねがいします。すみません。
おはようございます。
(マツ)さん、何がしたいのでしょうか?ちょっと疑問です。ご注文も多いですし(笑)
>”回収”のシート 現在 A2 → A7 B2→B7に修正済み
>”手形”→”手形シート”のB5に >”1日”→”1日シート”B5にデータが行く >予定調整シートのB5に行く いくつのシートがあるんですか?
とりあえず、予定調整シートを作成してください。ちょっと実績シートの内容を変えました。あと、帳票A(小文字対応ですので・・・)
Sub test()
Worksheets("実績").Select
With Worksheets("実績")
.Range(Cells(5, 1), Cells(Sheets("実績").Cells(65536, 2).End(xlUp).Row, 16)) = ""
.Cells(5, 1) = "コード"
.Cells(5, 2) = "分類"
.Cells(5, 3) = "名"
.Cells(5, 6) = "予定B"
.Cells(5, 7) = "回収"
.Cells(5, 8) = "未収"
.Cells(5, 9) = "予定"
.Cells(5, 11) = "変更日"
.Cells(5, 12) = "再"
.Cells(5, 13) = "再々"
.Cells(5, 14) = "回収日"
.Cells(5, 15) = "差額"
.Cells(5, 16) = "必要事項"
.Cells(5, 17) = "備考"
End With
Dim a, n As Long
n = 5
With Worksheets("実績")
For a = 9 To Sheets("帳票A").Cells(65536, 2).End(xlUp).Row
If Sheets("帳票A").Cells(a, 28).Value = "未回収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 2).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=帳票A!R[" & a - n & "]C+帳票A!R[" & a - n & "]C[5]"
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 17).Value = "現・小"
ElseIf Sheets("帳票A").Cells(a, 28).Value = "差額発生" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 2).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=帳票A!R[" & a - n & "]C+帳票A!R[" & a - n & "]C[5]"
.Cells(n, 7).FormulaR1C1 = "=帳票A!R[" & a - n & "]C[8]"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 15).Value = "差額発生"
.Cells(n, 17).Value = "現・小"
End If
If Sheets("帳票A").Cells(a, 29).Value = "未回収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 2).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=帳票A!R[" & a - n & "]C[1]+帳票A!R[" & a - n & "]C[6]"
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 17).Value = "手"
ElseIf Sheets("帳票A").Cells(a, 29).Value = "差額発生" Then
n = n + 1
.Cells(n, 1).Value = Sheets("帳票A").Cells(a, 2).Value
.Cells(n, 2).Value = "売"
.Cells(n, 3).Value = Sheets("帳票A").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=帳票A!R[" & a - n & "]C[1]+帳票A!R[" & a - n & "]C[6]"
.Cells(n, 7).FormulaR1C1 = "=帳票A!R[" & a - n & "]C[9]"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 15).Value = "差額発生"
.Cells(n, 17).Value = "手"
End If
Next a
For a = 7 To Sheets("回収").Cells(65536, 2).End(xlUp).Row
If Sheets("回収").Cells(a, 11).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=回収!R[" & a - n & "]C[-1]"
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 17).Value = "現"
ElseIf Sheets("回収").Cells(a, 11).Value = "差額発生" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=回収!R[" & a - n & "]C[-1]"
.Cells(n, 7).FormulaR1C1 = "=回収!R[" & a - n & "]C"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 15).Value = "差額発生"
.Cells(n, 17).Value = "現"
End If
If Sheets("回収").Cells(a, 12).Value = "未収" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=回収!R[" & a - n & "]C"
.Cells(n, 7).Value = "0"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 17).Value = "手"
ElseIf Sheets("回収").Cells(a, 12).Value = "差額発生" Then
n = n + 1
.Cells(n, 1).Value = Sheets("回収").Cells(a, 2).Value
.Cells(n, 2).Value = "前"
.Cells(n, 3).Value = Sheets("回収").Cells(a, 3).Value
.Cells(n, 6).FormulaR1C1 = "=回収!R[" & a - n & "]C[-1]"
.Cells(n, 7).FormulaR1C1 = "=回収!R[" & a - n & "]C"
.Cells(n, 8).FormulaR1C1 = "=RC[-2]-RC[-1]"
.Cells(n, 15).Value = "差額発生"
.Cells(n, 17).Value = "手"
End If
Next a
End With
End Sub
で、実績シートに、下記コードをコピペ。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 16 Then
If Target.Value = "調整" Then
Dim a As Long
If Worksheets("予定調整").Cells(5, 2) = "" Then
a = 5
Else
a = Worksheets("予定調整").Cells(65535, 2).End(xlUp).Row
End If
Worksheets("実績").Range(Cells(5, 1), Cells(5, 17)).Copy _
Destination:=Worksheets("予定調整").Cells(4, 2)
Worksheets("実績").Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Copy _
Destination:=Worksheets("予定調整").Cells(a + 1, 2)
Worksheets("実績").Rows(Target.Row).Delete Shift:=xlUp
End If
End If
End Sub
あとは、(マツ)さん自身で、挑戦してみてくださいね。
(ken)
>(キリキ) さん、フォローありがとうございます。 いえいえ、(^^) kenさん、まだ日本じゃないの? (何処だか知らないけど・・・) 時差とか平気なのかな〜??
>実は、変数をたくさん定義してしまい、見苦しかったので、このページ上で変更してたら・・・ うんうん、あるある。 σ(^o^;)なんて、いつもですよ・・・ 差分チェックなんてされてたら。。。(>_<)
TO マツさん
まず、kenさんの作ってくれたコードをデバックしてみるのは如何でしょう?
1)Alt + F11 で、Microsoft Visual Basic を出す。
2)Microsoft Visual Basic のウィンドを小さくする。
エクセルと上記ウィンドが、両方見れるようにする。
3)Worksheets("実績").Select に、カーソルを置き、F9 を押す。
その行に、●が着いて色が変わればOK。
4)F8 を押し、1行1行コードを実行し、エクセルの画面を追いかける。
どのコードで、何をしているかがわかると思います。
5)解らないことは、まずヘルプに聞いてみる。
※コード上の解らない場所に、カーソルを置き F1 を押すとそのヘルプが見れます。
以上です。 出来れば、Book名を変えて保存を行った後に上記を行い、色々いじって見ると 何が変わったか解ると思いますよ〜♪ それでも解らないことや、つまずいたりしたらいつでもここに質問しちゃおう〜 皆、親切な人達だから、親身になって教えてくれると思います☆
(キリキ)(〃⌒o⌒)b
(キリキ)さん、どうもです。
ken は、香港ですよ。あれから、日本語のエクセルをインストールして、マクロ勉強中です。。。
時差は一時間。あまり関係ないかも、です。昨日、今日は、台風のため、大雨。なので、ちょっと暇ですね。
ちょくちょく顔は出してるんですが、あまり書き込みはしてないです・・・
今後とも、よろしくです。
(ken)
こちらこそよろしくお願いいたします。
>ken は、香港ですよ。 香港ですか〜♪ ジャッキーに会えそう(笑
(キリキ)(〃⌒o⌒)b
香港からの(ken)さん (キリキ)さん 本当にありがとうございました。 いろいろと 申し訳ありませんでした。 貴重なお時間をすみません。ありがとうございました。 上記の方法で 勉強してみます。 今後とも よろしくお願いします。
予定調整シートに、標準モジュールに上記マクロをコピぺしました。(帳票シートにもしてみました。)
>下実績シートに、下記コードを コピペ しました。
帳票Aのデータが実績シート・予定調整シートにもこないのです。すみません。 開始位置 ”帳票A”のシート C3 → B9に ”回収”のシート B2 → B7に ”実績”のシート A2 → A6に 上記の シート開始位置と 以前の開始位置でもしました。 何度も 何度もすみません。お願いします。 (マツ)
>予定調整シートに、標準モジュールに上記マクロをコピぺしました。(帳票シートにもしてみました。) もう一度、おさらい。
<帳票A>
B C J K L M N O P Y Z AA AB AC
7 予定B 実績
8 コード 名 日 現・小 手 サ 日 現・小 手 サ 現・小 手 現・小 手
9 12 あ 2000 1000 2000 1000 0 0 回収済 回収済
10 1 い 500 500 0 0 回収済
11 3 う 2000 1500 500 1500 1500 差額発生 未回収
12 45 え 2000 2000 2000 500 0 1500 回収済 差額発生
13 55 お 2000 500 500 2000 0 未回収 回収済
14 2 か 2000 2000 0 未回収
<回収>
B C D E F G H I J K L
6 コード 名 日 現 手 実績現 実績手 差現 差手 現 手
7 11 た 2200 1100 2200 0 0 1000 未収
8 25 ち 1500 0 0 0 1500 0
9 33 つ 1500 500 0 500 1500 0 未収
10 15 て 2200 0 2200 0 0 0
11 45 と 1500 0 0 0 1500 0 未収
12 32 な 0 1000 0 1000 0 0
<実績> まったくの空欄でOK。
<予定調整> こちらも、空欄でOK。実績シートのP列に、"調整"と入力すると、実績シートに移ります。
ここまでが準備段階です。
次に、 @ ファイルを開いてから、Altを押しながら、F11を押します。 A たぶんグレーの画面が出ますので、表示→プロジェクトエクスプローラーをクリック B 挿入→標準モジュールをクリックし、現れたMacro1上に、Sub test() 〜 EndSub を貼り付け。 C プロジェクトエクスプローラーのVBAProject の+、Microsoft Excel Object の+をクリック、実績のシートを 右クリックし、コードの表示をクリック。現れた画面に、Private Sub Worksheet_Change(ByVal Target As Range) 〜 End Sub を貼り付け。 D Altを押しながら、Qを押し、普通画面に戻します。 E ツール→マクロ→セキュリティで、セキュリティレベルを中にしてOKをクリック後、保存してから、そのファイルを 閉じます。 F 再度、ファイルを開き、セキュリティ警告画面が出ますので、マクロを有効にするをクリック。
これで、再度お試しを。うまくいくといいですね。(ふ〜、疲れた。。)
(ken)
できました。上手く動きました。本当に本当にありがとうございます。 感謝!です。 すばらしいマクロ 明日 早速使わせていただきます。 少しでも 理解できるよう勉強します。ありがとうございました。 (マツ)
こんばんは。 昨日はありがとうございました。 今日会社でさっそく使わせていただきました。 また 1つ教えていただきたいのですが お願いします。 ”実績シート”の P列に 「調整」と入力すると→”予定調整シート”B5〜 「調整」のデータが 貯まるようにしたいのですが 今ですと 1つしか表示できません。 本当に 申し訳ありませんが お願いします。 (マツ)
>貯まるようにしたいのですが 今ですと 1つしか表示できません あれ?おかしいですね。"予定調整"シートの最下行に、どんどん加わりませんか?
って思って、再診断。
Cells(a, b) は、a は行数、b は列数を示します。
If Worksheets("予定調整").Cells(5, 2) = "" Then '予定調整シートのセルB5が空欄時
a = 5 'a = 5に設定
Else 'そうでなければ
a = Worksheets("予定調整").Cells(65535, 2).End(xlUp).Row 'a = 予定調整シートのB列最下行に設定
End If
Worksheets("実績").Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Copy _
Destination:=Worksheets("予定調整").Cells(a + 1, 2)
'実績シートのCells(調整と入れた行, 1)〜Cells(調整と入れた行, 17)を、
'予定調整シートの(a + 1, 2)にコピー
っていう命令なんですが。
うわぁ〜、すいません。。。
悪いところ分かりましたか?
a=5
のところ、
a=4
に変更してみてください。でわ、ご検討を。 (ken)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.