- ベストアンサー
品名を変える表で在庫数を計算する方法
- CSVファイルには品名、数量などのデータが入っています。エクセルで開き、品名と日付の優先順位で昇順に並べ替えます。品名が変わるときに空白行を挿入します。
- A列の値が2の場合、D列の値を切り取り、E列に貼り付けます。これにより入荷数と出荷数を表現します。
- F列の全ての行に、D列とE列の結果から計算した残数を入れたいです。ただし、D列とE列が空白の行は計算しないようにします。
- みんなの回答 （43）
- 専門家の回答
質問者が選んだベストアンサー
おはよう、gx9wxさん。 昨夜はお座敷の時間が迫っていて説明できませんでしたが、TEST03とTEST02 の違いはもうおわかりですね？ > G1→G2 > C1→C2 > にしたのですがERRになりました。 > 「書式が相違して貼付できません」 「書式」じゃなく、「コピー領域と張り付け領域の形が違うため」とでたんでしょ？ 多分、素直でかわいいgx9wxさんは、ご丁寧に .Columns("G:G").Copy .Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換 の部分まで、G2に直したんじゃないのかな？ そうだとすれば、エラーの理由は簡単です。 コピーしたのがG列の全部（65536行）なのに、張り付け先はG2以降の65535行になっちゃうので「形が違うぞぉ!ヾ(￣□￣； )ノ！」とエクセルに叱られわけです。 1行目が項目行なら、ここは数式じゃなく文字列ですよね？ ならば、ここは .Columns("G:G").Copy .Range("G1").PasteSpecial Paste:=xlPasteValues のままで何の問題もなかったわけです。 以上、蛇足ですがご参考のため。
その他の回答 (42)
- merlionXX
- ベストアンサー率48% (1930/4007)
おはよう、gx9wx さん。 > ただし説明済みですが項目欄も一緒に貼り付きました。 >> ４行目：必ずここからデータ開始 ここを見落としていました、ごめんね。 これでどうでしょ？ Sub 最終行抽出03() ' 品名単位での各最終行を（空白行の一つ上の行の事）を抽出し ' Sheets("集計")A～O列の値をマクロBOOKSheets("最終行データ")に転記 Dim i As Long, j As Long Dim ls As Range With Sheets("集計") i = .Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 Set ls = .Cells.SpecialCells(xlLastCell).Offset(1) ls = " " 'UsedRangeを１行増やす For Each c In .Range("A4:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列4行目以降の空白セル j = j + 1 'カウント c.Offset(-1).Resize(1, 15).Copy ThisWorkbook.Sheets("最終行データ").Cells(j, "A").Resize(1, 15) '1行上右15列範囲をマクロBOOKに転記 Next c '繰り返す If ls.Value = " " Then ls.ClearContents End With End Sub
お礼
ご迷惑をおかけしています。 Sub 最終行抽出03() を試しました。 うまくできました。 これなら、表の装飾後でも大丈夫です。 ありがとうございました。
補足
いえ、とんでもございません。 ありがとうございます。 今回教えてもらった物を試す前に、 昨日自分で調べた内容を報告します。 それにより今回教えてもらった内容で 「該当セルが見つかりません」のＥＲＲは 直りますでしょうか？ あと要望も（すいません）1件追記しました。 項目行まで最終行データとして転記されてしまう件は 自分の考えた方法（記述の順番変更）で解決しました。 →今回教えてもらった物も試します。 「該当セルが見つかりません」の方ですが 昨日、深夜まで、いろいろなデータで調べてやっと 症状の原因らしき物を発見できました。 Sub 最終行データ張付け() にてシート【最終行データ】のデータがシート「集計」に 貼りつかない時がある。 その場合↓ Sub 残数計算2()にて ↓ With .SpecialCells(xlCellTypeBlanks) 「該当セルが見つかりません」 となる。 貼りつかない原因は、 シート【最終行データ】のデータにありました。 このデータにおいて Ｌ列（受） Ｍ列（入） Ｎ列（出） において どれかの列が全行空白の場合は シート【最終行データ】のデータをシート「集計」に貼付ける時に 全ての行のＬ，Ｍ，Ｎ列を空白で貼り付けてしまいます。 それが原因でした。 ただ上記のようになる場合はあるので、そこを対応する必要が あるのでは？と思いました。違っていたらすいません。 （品名単位の先頭行がL,M,N列が空白なのでERRであってますよね。） 例（Ｌ列が全行空白の場合） 品名---Ｌ--M--N--O みかん----20-----20 りんご----10-----50 いちご--------5--12 ↓ シート【最終行データ】のデータをシート「集計」に貼付けると Ｌ，Ｍ，Ｎ列が空白で張り付いてしまう。 品名---Ｌ--M--N--O みかん------------- りんご------------- いちご------------- -------------------- もう一つこれはそういう記述なのですが シート【最終行データ】のデータにてＬ列にデータがある時、 （Ｍ，Ｎ列は空白です）の計算です。 シート【最終行データ】のデータをシート「集計」に貼付て 編集が行われるとそれは必ず品名単位の先頭行になります。 これのＯ列が貼りついた時は数値が有り Ｏ列の計算がされると空白になります。 その下の行への計算は成立しています。 ですが先頭行が空白の為、表としてはまずいのかなと。 この先頭行のみＯ列を残せるのでしょうか？ 例 シート【最終行データ】のデータ 日付--品名---Ｌ--M--N--O 10/2--みかん--1--------20 10/2--りんご----10-----50 10/2--いちご--------5--12 ↓ シート【最終行データ】のデータがシート「集計」に 正しく貼り付いた 日付--品名---Ｌ--M--N--O 10/2--みかん--1--------20 10/2--りんご----10-----50 10/2--いちご--------5--12 編集で先頭行になりＯ列の計算がされると 先頭行のＯ列も空白になる。 計算は反映されているので正しいが表としては..... 日付--品名---Ｌ--M--N--O 10/2--みかん--1----------←ここの空白が.... 10/3--みかん-----2-----22←計算は成立でも根拠が 10/4--みかん--------5--17 10/5--みかん--1----------←空白でＯＫ 10/6--みかん-----3-----20←上の行を見ればわかる
- merlionXX
- ベストアンサー率48% (1930/4007)
見捨ててませんよ、大丈夫。 Sub 抜き出し03 はSub 最終行抽出() に名前を変えていたのですね。 では、それに手を入れます。 マクロがあるBOOKに最終行転記用としてシート、「最終行データ」 をつくってください。 このシートには何も記載しないでください。 確認しますが、作業中のBOOKのアクティブなシートの名は「編集」なんですね？ Sub 最終行抽出02() 品名単位での各最終行を（空白行の一つ上の行の事）を抽出し Sheets("編集")A～O列の値をマクロBOOKSheets("最終行データ")に転記 Dim i As Long, j As Long Dim ls As Range With Sheets("編集") i = .Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 Set ls = .Cells.SpecialCells(xlLastCell).Offset(1) ls = " " 'UsedRangeを１行増やす For Each c In .Range("A1:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル j = j + 1 'カウント c.Offset(-1).Resize(1, 15).Copy ThisWorkbook.Sheets("最終行データ").Cells(j, "A").Resize(1, 15) '1行上右15列範囲をマクロBOOKに転記 Next c '繰り返す If ls.Value = " " Then ls.ClearContents End With End Sub これで無事、マクロのあるBOOKに作成した「最終行データ」という名のシートのA～O列に正しくデータが張り付くことを確認してください。 あとは、並べ替えや残数の集計をする前に、以下のマクロをCallしてデータを取り込めるか確認してください。 Sub 最終行データ張付け() マクロBOOKSheets("最終行データ")に保存してあるデータを末尾に転記 Dim i As Long, j As Long With Sheets("編集") i = .Cells(Rows.Count, "A").End(xlUp).Row + 1 'A列最終行+1 ThisWorkbook.Sheets("最終行データ").Range("A1").CurrentRegion.Copy .Cells(i, "A") End With ThisWorkbook.Sheets("最終行データ").Range("A1").CurrentRegion.ClearContents '保存データをクリア End Sub ふ～っ、疲れました。 うまくいくといいですね。
お礼
ありがとうございました。 以下の様に記述の順番を変えました。 Sub 自動編集() CSVファイル選択し 新規BOOKにデータ貼付 Call 編集 名前をつけて保存 End Sub ------------------- Sub 編集 列を挿入したりの編集を数種類（これでＮ列まで増加） Call 最終行データ張付け G列、C列、D列の優先順で昇順で並べ替え H列にて上の行と違う値の所に空白行を入れる Call 残数計算2 Call 最終行抽出02←コメントイン 表の装飾 'Call 最終行抽出02←コメントアウト End Sub ですが以下のプロシージャーでＥＲＲになってしまいます。 Sub 残数計算2() '2010年10月25日 '残数計算 M列を入庫、N列を出庫としO列に残数を転記する Dim i As Long i = Cells(Rows.Count, "A").End(xlUp).Row With Range("O1:O" & i) With .SpecialCells(xlCellTypeBlanks) .FormulaR1C1 = "=IF(ISBLANK(RC[-4]),FALSE,SUM(R[-1]C,RC[-2])-RC[-1])" End With .Copy .PasteSpecial Paste:=xlValues Application.CutCopyMode = False .SpecialCells(xlCellTypeConstants, xlLogical).ClearContents End With With Range("L1:L" & i) .SpecialCells(xlCellTypeConstants, xlNumbers).Offset(0, 3).ClearContents End With End Sub ↓ 記述順番変更により、このプロシージャーが走る時は 計算対象データが1行目からになるので With Range("O1:O" & i) With Range("L1:L" & i) ↓ O3→O1 L3→L1 にしました。 ですが With .SpecialCells(xlCellTypeBlanks) 「該当セルが見つかりません」 となってしまいました。 やはり残数計算（O列）時は1行目からデータではいけないのでしょうか？
補足
>確認しますが、作業中のBOOKのアクティブなシートの名は >「編集」なんですね？ 申し訳ありません。Sub自動編集、Sub編集と 識別しやすくする為 いつの間にか【集計】になっていました。 今回教えていただいた記述で「編集」の部分は →【集計】に直しました。m(__)m >これで無事、マクロのあるBOOKに作成した「最終行データ」 >という名のシートのA～O列に正しくデータが >張り付くことを確認してください。 正しく貼り付きました。完璧です。 ＞あとは、並べ替えや残数の集計をする前に、 ＞以下のマクロをCallしてデータを ＞取り込めるか確認してください。 完璧に取り込めました。 ただし説明済みですが項目欄も一緒に貼り付きました。 ＞１行目：表のタイトル ＞２行目：各列の項目名 ＞３行目：絶対に空白の行 ＞（空白行を入れるマクロで必ず空白行になる） ＞４行目：必ずここからデータ開始 ＞なのですが、 ＞転記先開始行セルＱ２からＡＥに転記のさい ＞まずこの２行目（各列の項目名）が転記され ＞Ｑ３からＡＥ３に最初の抽出データが転記されます。 でその後、並べ替えが走るのでこの張り付いた項目欄の行は 一番下の最終行に追いやられました。 繰り返し作業していくとこの 項目行 が当たり前ですが毎回1行づつ増えてしまいます。 1行目、2行目の行挿入は、編集終了後保存前直線に 行われる表の装飾です。 （その他にも値を中央とか罫線とか色塗りとか） 最終行の抽出にはこれらは関係ありませんので 品名が変わる所で空白行を入れて Ｏ列に残数計算を行い、Ｏ列が出来上がってから そこで Call 最終行抽出02 を走らせて、 それから表の装飾を行えばいいでしょうか？ 記述を変更して試してみます。
- merlionXX
- ベストアンサー率48% (1930/4007)
> ・マクロ止めて手作業でデータ貼付をした > 部分。 > ここをマクロで行わないといけません。 > ここを教えていただきたいです マクロ止めて手作業でとは、ブレークポイントを設定して一時中断したということですね？なかなか高度な技術をお持ちですね。 > 編集終了でBOOK1が名前を付けて保存されます。 > これの保存直前に > 教えていただいたSub 抜き出し03を使用して、 > 別BOOKに貼付して保存したいのですがそれは可能でしょうか？ こちらの方が先ですね。 この保存した別BOOKの全データを読み込んで、作業中のBOOK1のA～O列の最後に貼り付けたいのですよね？だったらこちら（別BOOK）の仕様をきめておかないといけませんから。 で、提案ですが、何も保存しておくBOOKを増やさず、マクロを記述してあるBOOKにはワークシート上、何もデータがないんですよね？だったらこのマクロを記述してあるBOOKに仮に「最終行データ」というシートを作り、そこに保存したらどうでしょうか？ Sub 抜き出し03 はたぶん、そちらで列や行の配置を修正されて使ったと思います。 修正後のSub 抜き出し03をみせてもらえませんか？ それから A～０列の配置で、区分、取引日、品名、受、入、出、残（これはO列でしたね？）など、サンプルとは当然違っているでしょうからできるだけ正確な配置をおしえてください。もちろん企業秘密で出せないのであれば、別の言葉に置き換えてもかまいませんが取引日、品名、受、入、出、残は変えないでください。わたしが混乱してわけがわからなくなりますから。 月末が近づき、わたしもちょっと忙しくなってきました。 現実のデータや現在のコード等を見られたらどんなに簡単に解決できるかと思うととてもじれったいです。 本来、もうこのあたりまでボランティアではすべきではないのでしょうが・・・・。
お礼
忙しいところ、対応くださいまして 本当にありがとうございます。
補足
お手数かけます。 >マクロ止めて手作業でとは、ブレークポイントを設定して >一時中断したということですね？なかなか高度な技術をお持ちですね。 参考書のコピーです。テクニックでは有りません。 ＞提案ですが、何も保存しておくBOOKを増やさず、 ＞マクロを記述してあるBOOKにはワークシート上、 ＞何もデータがないんですよね？ ＞だったらこのマクロを記述してあるBOOKに仮に ＞「最終行データ」というシートを作り、 ＞そこに保存したらどうでしょうか？ 素晴らしいアドバイスです。 作業者がファイル選択を間違えるととんでもない表になります。 こちらの方が安全です。 ただし、マクロが入っているエクセルは シート1はシート1でコマンドボタンのみ、 シート２はシート名【作業者名簿】として Ａ列に作業者コード Ｂ列に作業者名 が入っています。 シート３はあいています。 >Sub 抜き出し03 はたぶん、 >そちらで列や行の配置を修正されて使ったと思います。 >修正後のSub 抜き出し03をみせてもらえませんか？ 使用している物そっくりそのままです。 Sub 最終行抽出() '品名単位での各最終行を（空白行の一つ上の行の事）を抽出し ’そのＡからＯ列の値をＱ列からＡＥ列に転記していく Dim i As Long, j As Long i = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 j = Cells(Rows.Count, "Q").End(xlUp).Row + 1 'Q列最終行+1 Cells.SpecialCells(xlLastCell).Offset(1) = " " 'UsedRangeを１行増やす For Each c In Range("A1:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル c.Offset(-1).Resize(1, 15).Copy Cells(j, "Q").Resize(1, 15) '１行上の右に15列範囲をQ列～に転記 j = j + 1 'カウント Next c '繰り返す End Sub ただし、編集後には １行目：表のタイトル ２行目：各列の項目名 ３行目：絶対に空白の行 （空白行を入れるマクロで必ず空白行になる） ４行目：必ずここからデータ開始 なのですが、 転記先開始行セルＱ２からＡＥに転記のさい まずこの２行目（各列の項目名）が転記され Ｑ３からＡＥ３に最初の抽出データが転記されます。 >それから >A～０列の配置で、区分、取引日、品名、受、入、出、 >残（これはO列でしたね？）など、 >サンプルとは当然違っているでしょうから >できるだけ正確な配置をおしえてください。 Ａ：区分 Ｂ：区分２ Ｃ：取引日 Ｄ：時刻 Ｅ：作業者コード Ｆ：作業者名 Ｇ：ステーション Ｈ：品名 Ｉ：品名あだ名 Ｊ：識別１ Ｋ：識別２ Ｌ：受入 Ｍ：入 Ｎ：出 Ｏ：残 ＞本来、もうこのあたりまでボランティアでは ＞すべきではないのでしょうが・・・・。 申し訳ありません。どうか見捨てないでください。 お願いします。
- merlionXX
- ベストアンサー率48% (1930/4007)
おはよう！ >（マクロの途中でデータ挿入？？？） 途中でやってもいいけど、列の編集をするマクロと、品名、日付で並び替えをするマクロは別のプロシージャ（Sub～End Subのくくり）ですよね？ だったら、Sub データ挿入() をひとつ作って、品名、日付で並び替えをするマクロが作動する前に動かせばいいだけでは？ > 今から自分のマクロを >・別途保存してあった最終行だけのデータ >（これはO列に残数がある）を一番下にコピペ先頭に > 必要なだけの行を挿入して > 最終行だけ抽出したデータを最終行に貼付 > その後に >>品名、日付で並び替えをし、 >>空白行をいれ、残数を計算すればいいのでは？ > できるように、書き換えてみます。 ちょっと待って！ 品名、日付で並び替えをすれば、古い日付のはずの最終行だけ抽出したデータは自動的に品名別の一番上にくるはずですよね？ だったら、「必要なだけの行を挿入して」の部分は不要じゃないですか？
お礼
申し訳ありません。 回答ＮＯ．８のお礼に 週明けて、もう一度merlionXXのアドバイスを読んだら ぱっとひらめきました。 ↓ （正）merlionXXさん さん付けを忘れてしまいました。 大変失礼いたしました。
補足
>途中でやってもいいけど、列の編集をするマクロと、 >品名、日付で並び替えをするマクロは別のプロシージャ >（Sub～End Subのくくり）ですよね？ いえ、同じなのです。 ・Sub 自動編集 はCSVをBOOK1に転記し 名前を付けて保存するマクロ。 でそのSub 自動編集の途中で ・Call Sub編集 が呼び出されます。 Sub 編集 というプロシージャーです。 この中で 品名、日付で並び替えをしてから 列挿入などが行われます。 →これの順序を入れ替える記述に変更しました。 >品名、日付で並び替えをすれば、 >古い日付のはずの最終行だけ抽出したデータは >自動的に品名別の一番上にくるはずですよね？ >だったら、「必要なだけの行を挿入して」の部分は >不要じゃないですか？ 了解しています。 並べ替えの直前に最終行の下の行へ貼付する方法で考えてます。 （今は手動ですけど(^_^;) 申し訳ありません。m(__)m
- merlionXX
- ベストアンサー率48% (1930/4007)
> 2行目空白で3行目からで3行目が計算対象時もある > G4→O3,D4→L3に ↓ > .Offset(0, 3).ClearContents > の(0, 3)の部分はこのままでいいのでしょうか？ 「受」に数値があればその3つ右隣の列（L列であれば0列、つまり「残の列」）をクリアさせています。 あと、あまりたくさんお書きで、こちらも何がなんだかわからなくなっています。 CSVのデータを保存用BOOKにコピーして列を挿入し何らかの作業をして結果的にA～O列となり、O列には残数がはいるのですよね？ それなら、編集が終わったあとから、その先頭に必要なだけの行を挿入して最終行だけ抽出したデータを貼り付ければ、列数は同じで簡単なのではないですか？と昨日お尋ねしましたが、それはどうなんでしょう？ もちろん列の編集をしても、まだ並び替えをせず、品名の間に空白行も入れず、O列に残数もいれません。 その状態なら、別途保存してあった最終行だけのデータ（これはO列に残数がある）を一番下にコピペしても列のずれはありませんよね？ そうしてから品名、日付で並び替えをし、空白行をいれ、残数を計算すればいいのでは？ ただし品別集計は、すでに残数が入っている最終行のO列を置き換えないように、O列の空白セルにだけ行います。（その例は下記のとおり） Sub 品別集計04() Dim i As Long i = Cells(Rows.Count, "A").End(xlUp).Row With Range("O3:O" & i) With .SpecialCells(xlCellTypeBlanks) .FormulaR1C1 = "=IF(ISBLANK(RC[-4]),FALSE,SUM(R[-1]C,RC[-2])-RC[-1])" End With .Copy .PasteSpecial Paste:=xlValues Application.CutCopyMode = False .SpecialCells(xlCellTypeConstants, xlLogical).ClearContents End With With Range("L3:L" & i) .SpecialCells(xlCellTypeConstants, xlNumbers).Offset(0, 3).ClearContents End With End Sub どのような編集なのかわからないので、もし並び替えを先にしないと編集できないのならだめですが・・・・。
お礼
マクロを書き換えてみました。 （Sub 品別集計04()も使いました） 01 マクロ入のブックを開きます 02 コマンドボタンをクリック（Sub 自動編集が起動） 03 エクセル標準機能のファイル選択画面が出る 04 CSVファイルを選択しクリック（Sub 自動編集が再開） （ここは作業者が行う） 05 BOOK1が開きシート名が「編集」と変更され そこに指定したCSVファイルのデータが転記。 06 CSVファイルは閉じられる 07 Sub 自動編集 内の Call 編集 が起動 編集作業中にデータがO列に増加した所でマクロを止めて ・あらかじめ品名単位の最終行を抽出し 別BOOKに保存しておいたデータ（Aから0列です。） を最終行から２０行貼付ました。 08 Sub 編集 の残りを走らせました。 09 「編集終了」とメッセージボックスが出る 10 マクロ入のブックを閉じる 11 指定したフォルダを見ると編集後のエクセルファイルが 出来上がっている。 出来上がったデータ。→思っていたとうりの物でした。 ・並び替えは絶対一番最初 ・記述を変更するのはSub自動編集で Sub自動編集内のCallで呼び出すSub編集はいじらない と決め付けていたのが駄目でした。 週明けて、もう一度merlionXXのアドバイスを読んだら ぱっとひらめきました。 （先週金曜日のノイローゼは何だったのだろう。？？） ありがとうございました。感謝、感謝です。 ですが上記の ・マクロ止めて手作業でデータ貼付をした 部分。 ここをマクロで行わないといけません。 ここを教えていただきたいです。 もう一つお願いです。 編集終了でBOOK1が名前を付けて保存されます。 これの保存直前に 教えていただいたSub 抜き出し03を使用して、 別BOOKに貼付して保存したいのですがそれは可能でしょうか？ >あらかじめ品名単位の最終行を抽出し別BOOKに保存しておいた >データ（Aから0列です。） に該当します。 ・編集が終了すると常にエクセルファイルが2個できる事になります。 ・私のマクロ Sub 編集の一番最後にSub 抜き出し03を 走らせ、それの抽出した値を別BOOKに貼付となります。 （現在のSub 抜き出し03は同一シート内に貼り付きます。） それとも私の考えは常に複雑みたいなので もっといい方法がありましたら。 そのへんもアドバイスありましたらぜひお願いします。
補足
説明が下手で申し訳ありません。 >CSVのデータを保存用BOOKにコピーして列を挿入し >何らかの作業をして結果的にA～O列となり、 >O列には残数がはいるのですよね？ >それなら、編集が終わったあとから、 >その先頭に必要なだけの行を挿入して最終行だけ抽出したデータを貼り付ければ、 >列数は同じで簡単なのではないですか？ >もちろん列の編集をしても、まだ並び替えをせず、 >品名の間に空白行も入れず、O列に残数もいれません。 >その状態なら、別途保存してあった最終行だけのデータ >（これはO列に残数がある）を一番下にコピペしても >列のずれはありませんよね？ まったくそのとうりでした。 今手作業でおこなったら大丈夫でした。 そうなりますと 私の編集用のマクロの途中で、 ・別途保存してあった最終行だけのデータ （これはO列に残数がある）を一番下にコピペ先頭に 必要なだけの行を挿入して 最終行だけ抽出したデータを最終行に貼付 を実行しなければなりません。 そのマクロ記述は私には想像も付きません。 （マクロの途中でデータ挿入？？？） お手数ばかりおかけして恐縮ですが、教えていただきたいと 思います。どうかよろしくお願いします。 今から自分のマクロを ・別途保存してあった最終行だけのデータ （これはO列に残数がある）を一番下にコピペ先頭に 必要なだけの行を挿入して 最終行だけ抽出したデータを最終行に貼付 その後に >品名、日付で並び替えをし、 >空白行をいれ、残数を計算すればいいのでは？ できるように、書き換えてみます。
- merlionXX
- ベストアンサー率48% (1930/4007)
まだまだ先は長そうですね。（笑） お酒飲めないんですか、おいしいのに・・・。 こうしたいとおしゃる例ですが、「受」という列に１がある行には「入」「出」ともに数字がないということですか？ それならこれを識別に使えるので簡単な手直しですみます。 「受」は別に１でなくとも数値であれば「入」「出」ともに数字がないものという前提でやってみました。 配置はA列が区分D列が「受」、G列が「残」です。 ３行目が空白行で4行目からデータがあるものとします。 5万行のデータでどれだけ時間がかかるか教えてください。 Sub 品別集計03() Dim i As Long i = Cells(Rows.Count, "A").End(xlUp).Row With Range("G4:G" & i) .FormulaR1C1 = "=IF(ISBLANK(RC[-4]),FALSE,SUM(R[-1]C,RC[-2])-RC[-1])" .Copy .PasteSpecial Paste:=xlValues Application.CutCopyMode = False On Error Resume Next .SpecialCells(xlCellTypeConstants, xlLogical).ClearContents End With With Range("D4:D" & i) .SpecialCells(xlCellTypeConstants, xlNumbers).Offset(0, 3).ClearContents On Error GoTo 0 End With End Sub
お礼
ありがとうございます。 嬉しいやら悲しいやらです。 ダミーデーターでもOKで本番でもOKでした。 おかげで朝からの疲れが少し取れました。 ありがとうございます。 >こうしたいとおしゃる例ですが、 >「受」という列に１がある行には「入」「出」 >ともに数字がないということですか？ →はい。そうです。ここは数量ではなく作業回数です。 >「受」は別に１でなくとも数値であれば「入」「出」 >ともに数字がないものという前提でやってみました。 →システム上絶対 1 しか入りません。 よって「入」「出」は絶対空白です。 あったら私のマクロのバグです。 >5万行のデータでどれだけ時間がかかるか教えてください。 →Celeron 1.7Mhz Windows-XP Office2003 メモリ1G の環境で1秒でした。 >悲しいやら →説明不備によりご迷惑をおかけし、さらに新たな質問に対して 適切な記述を教えていただき、またそれで解決をしたのに こんな表現ですいません。 これで残数が正しくセットできました。 よって最終行の抽出と次回編集時への引渡し（合流）を要求されます。 でも私には出来ないのでまた教えていただかなければなりません。 良いイメージがわかず質問の仕方も難しいです。 01.マクロ入のBOOKを開きマクロ起動 02.CSVファイル選択画面が出る 03.編集対象CSVファイルを選択 04.CSVファイルのデータが編集用の別BOOKに転記 05.CSVファイルが閉じられる 06.エクセルファイル選択画面が開く 07.前回編集して保存されているエクセルファイル選択 08.品名ごとの最終行を検出しCSVファイルと同じデータ配列に加工して 別BOOKの03で転記したシートに同じく挿入転記 09.選択したエクセルファイルが閉じられる 10.編集マクロが起動 11.編集されて編集用の別BOOKエクセルファイルが保存される 12.マクロ入りのBOOKを閉じる 作業者は 01でボタンをクリック 03でCSVファイルを選択 06でエクセルファイル選択 と３回操作するのみで後は全自動。 手操作で行ってみましたが、 CSVファイルのデータを別ブックに転記します。 （10,000行とします。） で前回編集したエクセルファイルから最終行を抽出して （Sub 抜き出し03()を使います。） その後CSVファイルと同じデータ配列に加工した物 （ただしO列の値はO列においたまま）を 10,001行目から13,500行目まで転記します。 編集マクロを走らせ編集作業を行い、 残の計算（Sub 品別集計）をする所で止めて、 P列以降に値がある行だけ、その値（前回編集の最終行のＯ列）を O列にセットしてSub 品別集計を走らせると正しい残数になりません。 （Sub 品別集計だと 空白行の先頭行の M(入）の値とO（残）の値が相違すれば 強制的にO（残）はM（入）の値にされてしまいます。 そういう記述です。だから当然ですよね。） P列以降に入っている数値（前回編集の最終行のＯ列）を その行のM列とO列の双方にセットすれば Sub 品別集計 で思ったとうりの残数計算になります。とここまでは判明しました。 ですがこれをどうやってボタン1個で．．。 教えていただいた記述を本番用に変更しました。 本番では「受」→L、「残」→O 編集マクロ中これが走る時はデータが 2行目空白で3行目からで3行目が計算対象時もある G4→O3,D4→L3に ↓ .Offset(0, 3).ClearContents の(0, 3)の部分はこのままでいいのでしょうか？ Sub 品別集計03() Dim i As Long i = Cells(Rows.Count, "A").End(xlUp).Row With Range("O3:O" & i) .FormulaR1C1 = "=IF(ISBLANK(RC[-4]),FALSE,SUM(R[-1]C,RC[-2])-RC[-1])" .Copy .PasteSpecial Paste:=xlValues Application.CutCopyMode = False On Error Resume Next .SpecialCells(xlCellTypeConstants, xlLogical).ClearContents End With With Range("L3:L" & i) .SpecialCells(xlCellTypeConstants, xlNumbers).Offset(0, 3).ClearContents On Error GoTo 0 End With End Sub
補足
手作業で行いました。19はマクロでは行いません。 01 月曜にマクロ入のブックを開きます 02 コマンドボタンをクリック 03 エクセル標準機能のファイル選択画面が出る 04 システムが夜間バッチで保存している ネットワーク上のフォルダを選びその中に CSVファイルが1個だけあるのでそれをクリック （ここは作業者が行う） 05 BOOK1が開きシート名が「編集」と変更され そこに指定したCSVファイルのデータが転記。 このデータは先週の月曜から金曜までのデータ 06 CSVファイルは閉じられる 07 エクセル標準機能のファイル選択画面が出る 08 前回編集したエクセルファイルを選択 特定のフォルダに編集済エクセルファイルのみが 保存されているのでそのファイル名の一番新しい日付 のファイルを選択（ここも作業者が行う） 例 実績20101004.XLS 実績20101011.XLS 実績20101025.XLS ←これを選択する 09 BOOK2が開きシート名が「最終行」と変更され データが転記される。 10 エクセルファイルは閉じられる 11 BOOK2で Sub 抜き出し03 が走り最終行が抽出される その後CSVファイルと同じ配列に加工される。 ただしO列の値はO列にセットしたまま それ以外はシートから削除される。 12 こうして出来たBOOK2のデータを BOOK1の05で転記されたデータの最終行から （例えば35,001行目から）転記する 13 Call 編集 が起動 14 編集作業が行われる 並べ替えで品名単位の作業日順でソートされる その品名の郡の中で一番最初の行には必ず合流データが来る 編集で品名が変わる所で空白行が入る。 よって合流データは必ずその品名の先頭行 （空白行のすぐ下の行）にセットされる。 途中、Sub 品別集計が走る直前にP列以降に値がある行を 抽出。 その行は編集されて必ず空白行のすぐ下の行にいる その行だけP列以降の値をカット＆コピーでM列、O列にセットする Sub 品別集計が走って、O列（残）に計算結果が入る。 15 さらに編集は続く 16 編集が終了すると「編集終了」とメッセージボックスが出る 17 マクロ入のブックを閉じる 18 指定したフォルダを見ると編集後のエクセルファイルが 出来上がっている。 これは次回の編集時にまた使われる 19 CSVファイルをネットワーク上のフォルダから削除し 別フォルダに保存する 20 当日の夜間バッチでCSVファイルが出来上がるが 別データである （編集されエクセルファイルとして保存された物と 同一データは存在しない） ・9はデータ 他は数字 CSVファイル(A列からJ列） --A--J--K--L--M--N--O--P 1-9--9 2-9--9 編集後エクセルファイル（A列からO列） --A--J--K--L--M--N--O--P 1-9--9--9--9--9--9--9 2-9--9--9--9--9--9--9 編集後エクセルファイル最終行抽出して加工 （A列からJ列、K,L,M,Nは空白でO列） --A--J--K--L--M--N--O--P 1-9--9--------------5 2-9--9--------------6 CSVファイルと最終行加工データ合流 （CSVデータはA列からJ列） （合流データはA列からJ列、K,L,M,Nは空白でO列） --A--J--K--L--M--N--O--P 1-9--9 2-9--9--------------5 編集中 Sub 品別集計 が走る直前 （空白行のすぐ下の行は必ずP列に値がある） --A--J--K--L--M--N--O--P 1-9--9--9--9--9--9 2空白行 3-9--9-----------------5← 編集中 Sub 品別集計が走る直前の変更 （P列の値を切取りM,O列にコピー） --A--J--K--L--M--N--O--P 1-9--9--9--9--9--9 2空白行 3-9--9--------5-----5← 4-9--9--9--9--9--2 Sub 品別集計 終了後 （空白行の下の行から計算がされる 3行目はMとOが 5 4行目はNが2 5-2=3 4行目のO列は3になる） --A--J--K--L--M--N--O--P 1-9--9--9--9--9--9 2空白行 3-9--9--------5-----5← 4-9--9--9--9--9--2--3←
- merlionXX
- ベストアンサー率48% (1930/4007)
こんにちは。 大変苦労をされているようですね、お察し申し上げます。 昨夜（も）ついつい深酒をしてしまい、まだ朦朧としているせいか、（いやもともと頭が悪いのですが）お書きになっていることをよく理解できません。 言葉だけでやりたいことを伝えるのはむづかしいですね。 ちょっと整理させてください。 1.データがあるのはCSVファイル（A～J列） 2.マクロがあるBOOK 3.CSVのデータを貼り付けて編集し、保存するBOOK（A～O列、O列は残数） 4.各品名の最終行だけ抽出したデータを保存するBOOK 以上、4つのファイルがあるんですか？ NO.07 Callで呼び出した編集マクロで編集 とはCSVのデータを保存用BOOKにコピーして列を挿入し何らかの作業をして結果的にA～O列となり、O列には残数がはいるのですね？ それなら、編集が終わったあとから、その先頭に必要なだけの行を挿入して最終行だけ抽出したデータを貼り付ければ、列数は同じで簡単なのではないですか？
お礼
ありがとうございます。 >1.データがあるのはCSVファイル（A～J列） 当日発生データ約10,000行が夜間バッチで 挿入され続け1週間で50,000行になります。 金曜日に編集してエクセルファイルにしたら、 このCSVファイルはネットワーク上のフォルダから 退避させます。（行数増加防止） 月曜日から同じ名称のCSVファイルが発生しますが データ内には先週の物はありません。 >2.マクロがあるBOOK このBOOKにはコマンドボタンが1個あるだけクリックすると ファイル選択以外何もしなくていいです。 記述は下記に示します。このマクロ(自動編集)の作成で困ってます。 マクロ(自動編集)内にCall編集があります。←これは残数計算以外完成。 （残数計算は補足で説明済ですが私のミスで保留中） >3.CSVのデータを貼付て編集し保存するBOOK（A～O列、O列は残数） 上記２のマクロ(自動編集)が終了すると ファイル名がついて勝手に出来上がります。 これを実績として週単位で保管です。 余計なデータがあっては駄目で 式やマクロは入っていてはいけません。 >4.各品名の最終行だけ抽出したデータを保存するBOOK これは私が本件を行う為の構想で存在しません。 よって現在3個で作業者は毎週２のBOOKを操作するだけです。 １のCSVファイルを10月22日に２のBOOKを使い編集（３のBOOKになる） それは10月18日から22日までのデータです。 で10月29日にCSVファイルの編集をしても それは25日から29日のデータですから 22日に編集完了した物から最終行を抜いて 合流させてから編集しないと今回追加の残数の値が そのデータ内だけの値となってしまいます。 だから先週編集したデータの各品名の最終行だけは連結して欲しいと.. しかも今ある２のBOOKのボタン1個で。 マクロ（自動編集）に入れる事になります。無理です。(T_T) >NO.07 Callで呼び出した編集マクロで編集 >とはCSVのデータを保存用BOOKにコピーして列を挿入し >何らかの作業をして結果的にA～O列となり、 >O列には残数がはいるのですね？ →はい。そうです。 Sub 自動編集() Dim fName As String Dim wBook As Excel.Workbook Dim wSheet As Excel.Worksheet Dim buf As String Dim rng As Range Dim i As Integer Dim fLine As Variant Dim fso As Object Dim dPath As String fName = Application.GetOpenFilename( _ FileFilter:="CSVファイル(*.csv),*.csv" _ Application.ScreenUpdating = False Set fso = CreateObject("Scripting.FileSystemObject") dPath = fso.GetParentFolderName(fName) Application.SheetsInNewWorkbook = 1 Set wBook = Workbooks.Add Set wSheet = wBook.Worksheets(1) wSheet.Name = "集計" Set rng = wSheet.Range("A1") Dim n As Variant n = FreeFile Open fName For Input As #n i = 0 Do Until EOF(n) Line Input #n, buf fLine = Split(buf, ",") rng.Offset(i).Resize(, UBound(fLine) + 1).Value = fLine i = i + 1 Loop Close #n wSheet.UsedRange.Formula = wSheet.UsedRange.Value Call 編集 wBook.SaveAs Filename:=dPath & "￥実績" & Year(Date) & Month(Date) & Day(Date) & ".xls", _ FileFormat:=XlFileFormat.xlWorkbookNormal wBook.Close Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "編集終了" End Sub
補足
すいません。本件の回答の前に重大な問題がありました。 そっちを片付けないと、本件は成り立ちません。 （お酒 飲めません。頭の中のストレスを解消したいのですが できません。(T_T)） スレッドの一番最初の質問に不備がありました。 本番データは50,000行で見逃しました。 すいません。 説明不備より教えてもらった記述の為、問題が発生しました。 ＯＫですとお礼した Sub 品別集計02()の方です。 （入）は上の行の残に加算 （出）は上の行の残から減算ですが 以下の様に 品名単位でところどころに すべての列に値があるのに（入）と（出）の値の部分だけが 空白の行が存在します。 よって教えていただいた記述では当たり前ですが その行で計算が途切れてしまいます。 申し訳ありません。まずこちらを片付けないと最終行の抽出は無意味です。 （残数が正しくないので）この残がO列に該当します。 ↓こうしたい 区分---取引日----品名----受---入---出---残 空白行 1---2010/10/9---みかん--1---------------- 1---2010/10/12--みかん------100-------100 1---2010/10/13--みかん------100-------200 1---2010/10/13--みかん--1---------------- 2---2010/10/14--みかん------------50--150 1---2010/10/15--みかん------100-------250 1---2010/10/16--みかん-----------200--450 空白行 1---2010/10/14--りんご------100-------100 1---2010/10/14--りんご--1---------------- 1---2010/10/15--りんご------100-------200 空白行 1---2010/10/4---いちご--200-----------200 1---2010/10/6---いちご--1---------------- 2---2010/10/7---いちご------------30--170 2---2010/10/12--いちご------------40--130 2---2010/10/14--いちご------------30--100 ↓ところどころに（入）と（出）の双方が空白の行があり こうなってしまう。 区分---取引日----品名----受---入---出---残 空白行 1---2010/10/9---みかん--1---------------- 1---2010/10/12--みかん------100-------100 1---2010/10/13--みかん------100-------200 1---2010/10/13--みかん--1---------------- 2---2010/10/14--みかん------------50-(-50) 1---2010/10/15--みかん------100--------50 1---2010/10/16--みかん-----------200-(-150) 空白行 1---2010/10/14--りんご------100-------100 1---2010/10/14--りんご--1---------------- 1---2010/10/15--りんご------100-------100 空白行 1---2010/10/4---いちご--200-----------200 1---2010/10/6---いちご--1---------------- 2---2010/10/7---いちご------------30--(-30) 2---2010/10/12--いちご------------40--(-70) 2---2010/10/14--いちご------------30-(-100)
- merlionXX
- ベストアンサー率48% (1930/4007)
自分で作ったコードはまだ消さずに残しておいたのですが、コピペしたはずの回答を見るとなぜかOffset(-1)のマイナスが消えていました。 何かヘマばかりやらかしてますね、再度掲示します。 さて、今夜もこれからお出かけです。（笑） Sub 抜き出し03() Dim i As Long, j As Long i = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 j = Cells(Rows.Count, "N").End(xlUp).Row + 1 'N列最終行+1 Cells.SpecialCells(xlLastCell).Offset(1) = " " 'UsedRangeを１行増やす For Each c In Range("A2:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル c.Offset(-1).Resize(1, 6).Copy Cells(j, "N").Resize(1, 6) '１行上の右に６列範囲をN列～に転記 j = j + 1 'カウント Next c '繰り返す End Sub なお、質問6251880は解決したら締め切ってくださいね。 では。
お礼
ダミーデータで正しく抽出できました。 で本番です。 本番は、残数がO列に有ります。 またデータは４行目から始まっています。 1行目表のタイトル 2行目各列の項目名 3行目空白 4行目データ先頭 よって Sub 抜き出し05() Dim i As Long, j As Long i = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 j = Cells(Rows.Count, "Q").End(xlUp).Row + 1 'Q列最終行+1 Cells.SpecialCells(xlLastCell).Offset(1) = " " 'UsedRangeを１行増やす For Each c In Range("A3:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル c.Offset(-1).Resize(1, 15).Copy Cells(j, "Q").Resize(1, 15) '１行上の右に15列範囲をQ列～に転記 j = j + 1 'カウント Next c '繰り返す End Sub に変更して抽出が完璧にできました。 For Each c In Range("A3 A3だと列の項目まで抽出されます。 A4だとデータだけ抽出されます。 使い分けします。 どうもありがとうございました。 ＞質問6251880は解決したら締め切ってくださいね。 了解いたしました。
補足
計算も抽出もダミーでも本番でもＯＫでした。 ありがとうございます。 補足1/3(2010/10/22） スレッド最初の質問で ＞（２）完成したファイルの品名単位の最終行を抜出し ＞次のファイルを作成する時に合流させるマクロ これなんですが、抽出は今回でできました。 手順としては NO.01 マクロが入ったファイルを開く NO.02 マクロを起動 NO.03 CSVファイル選択画面 NO.04 CSVファイルを選択（データはAからJ列） NO.05 別BOOKが開きそれにデータが転記 NO.06 CSVファイルは閉じられる NO.07 Callで呼び出した編集マクロで編集 NO.08 最終的にはデータはA～O列となる （Ｏ列が今回教えていただいた部分） NO.09 システム日付をファイル名にして自動保存 NO.10 この保存されたファイルには式もマクロも入ってない ここまでは完成しています。 NO.11 作成されたファイルから品名単位の最終行を抽出 （今回完成しました） それを別ファイルに編集後(編集内容は下記記載)保管 後日(NO.01)から(NO.06)を行う NO.12 マクロが入ったファイルを開く NO.13 マクロを起動 NO.14 CSVファイル選択画面 NO.15 CSVファイルを選択（データはAからJ列） NO.16 別BOOKが開きそれにデータが転記 NO.17 CSVファイルは閉じられる NO.18 (NO.11)のファイルを選択させる NO.19 (NO.16)の別BOOKの最終行に転記 NO.20 (NO.07)から(NO.09)を行う (NO.11)の時データはA列からO列なので 合流用にF,L,I,L,M列を削除してAからK列にし K列（元O列）の値をQ列に移動しKからP列は空白で保存。 ↑NO.11の編集内容 合流後編集の過程で列挿入がされてしまうので Q列の値はV列までとんでしまいますが 編集の一番最初の並替で品名単位の先頭行になっているので 残数計算前（まだＯ列は全行空白）に マクロでその行だけV列→Ｏ列に カット＆コピーでいけるのでは？ ↑NO.21 ただ今回教えていただいたのは 計算した値をO列に転記 ですので 教えていただいた記述の場合 最初からところどころの行のＯ列に値があると やはり駄目でしょうか？ 教えていただきたいのはNO.11,18,19,21のマクロです。 ただしNO.21は計算前にO列に値があると駄目な場合は 無意味です。 ちなみにCSVファイルを開くマクロ（正常動作しています。） 記述は回答ＮＯ．４の補足に記載します。 文章では説明しにくいのでイメージとして 回答ＮＯ．３の補足に補足の補足をしました。 ほとんど寝ずに考えましたが限界です。 やろうとしている事は元々できないのかも知れません。 申し訳ありません。 説明がうまくできないので不明でしたらスルーしてください。
- merlionXX
- ベストアンサー率48% (1930/4007)
おっとっと・・・ 間違いです。 Cells.SpecialCells(xlLastCell).Offset(1) = " " 'UsedRangeを１行増やす にしてください。 ""じゃなくて" "です。（半角スペース）
お礼
お出かけというのに急がせてすいません。 どうもありがとうございました。
補足
すいません。 ＞""じゃなくて" "です。（半角スペース） 修正しましたが まだみかんが抽出されず、りんごといちごが抽出されました。 またそれらは最終行ではなく先頭行でした。 修正前と変化ありません。 申し訳ありません。
- merlionXX
- ベストアンサー率48% (1930/4007)
> またいちごが抽出できたら、続きの質問があります。 いちごはこれで大丈夫かな？ 補足にお書きになったダミーデータでやっています。 配置は、A列～F列 １行目が見出し ２行目からがデータです。 Sub 抜き出し03() Dim i As Long, j As Long i = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 j = Cells(Rows.Count, "N").End(xlUp).Row + 1 'N列最終行+1 Cells.SpecialCells(xlLastCell).Offset(1) = "" 'UsedRangeを１行増やす For Each c In Range("A2:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル c.Offset( 1).Resize(1, 6).Copy Cells(j, "N").Resize(1, 6) '１行上の右に６列範囲をN列～に転記 j = j + 1 'カウント Next c '繰り返す End Sub
お礼
すばやい回答を感謝いたします。
補足
すいません。 Sub 抜き出し03() Dim i As Long, j As Long i = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行 j = Cells(Rows.Count, "N").End(xlUp).Row + 1 'N列最終行+1 Cells.SpecialCells(xlLastCell).Offset(1) = "" 'UsedRangeを１行増やす For Each c In Range("A2:A" & i + 1).SpecialCells(xlCellTypeBlanks) 'A列の空白セル c.Offset(1).Resize(1, 6).Copy Cells(j, "N").Resize(1, 6) '１行上の右に６列範囲をN列～に転記 j = j + 1 'カウント Next c '繰り返す End Sub をコピペして行いました。 今度はみかんが抽出されず、りんごといちごが抽出されました。 またそれらは最終行ではなく先頭行でした。 おそらく空白行の下の行を抽出していると思われるのですが 記述のどこを変更すればいいか検討が付きません。 お手数かけます。
お礼
>Columns("G:G").Copy >.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換 >の部分まで、G2に直したんじゃないのかな？ はい。そのとうりです。 記述にコメント入れておきました。 どうもありがとうございます。