品名が変わる所で空白行がある表で在庫数を品名単位で計算したい

質問

品名が変わる所で空白行がある表で在庫数を品名単位で計算したい

１．CSVファイルがあります。
　　（データはでたらめに入っています。）画像(1)

　　Ａ列→半角の1か2
　　Ｂ列→日付
　　Ｃ列→品名
　　Ｄ列→数量

２．これをエクセルで開いて
　　Ｃ列、Ｂ列の優先順位で昇順で並べ替えます。画像(2)

３．Ｃ列の値が変わった所で空白行を入れます。画像(2)
　　（品名単位で区分けされました。）

４．Ａ列の値が２の場合Ｄ列の値を切取りＥ列に貼付けます。
　　画像(3)
　　Ｄ列が（入）
　　Ｅ列が（出）
　　になります　

ここまでのマクロは完成しています。

５．Ｆ列の全ての行にＤ列、Ｅ列の結果から計算結果で出た残数を
　　入れたい。（Ｄ，Ｅ列が空白の行は不要）画像(4)

　　Ｄ列は上の行のＦ列の値に加算しその値をＦへ
　　Ｅ列は上の行のＦ列の値から減算しその値をＦへ
　　例：F3=F2+D3-E3　
　　みかんはみかんだけで入出後の残数を、
　　りんごはりんごだけで入出後の残数を行ごとに入れたい。
　　かつ計算式は残したくない。

さらに、
CSVファイルは毎日行数が増え１週間で約50,000行になるので
このマクロを使い画像3の状態にして毎週金曜日に保存してます。
元のCSVファイルは削除します。
翌週にはまた新たなCSVファイルに翌週のデータがたまります。
先週の分の品名単位の最終行だけをコピーして
翌週のCSVファイルを編集するさいに合流させ、
ＮＯ．２の並べ変えの時に品名単位で一番上の行に挿入したいです。
で同じようにＮＯ．５を行いたいです。
画像(4)の場合６，９，１４行目を翌週のCSVファイルに合流させる。
（合流だけできればＮＯ．２の作業で品名単位で
　必ず一番上になりますので抜取りと合流だけしたい）

品名は１週のファイル内で約5,000種類です。
よって50,0000行が編集で55,000行に増加し
その中の5,000行は空白行（品名が変わるたびに挿入されている。）

（１）ＮＯ．５の画像(3)から画像(4)にするマクロ（計算式の入れ方？）
　　　（空白行には入れない）
（２）完成したファイルの品名単位の最終行を抜き出し
　　　次のファイルを作成する時に合流させるマクロ（画像(6)）
を教えてください。

回答No.42

merlionXX · ベストアンサー

おはよう、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
のままで何の問題もなかったわけです。

以上、蛇足ですがご参考のため。

お礼

>Columns("G:G").Copy
>.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
>の部分まで、G2に直したんじゃないのかな？

はい。そのとうりです。
記述にコメント入れておきました。

どうもありがとうございます。

回答No.43

merlionXX

> ・データ元を別の値に変換してから転記できるならこっちも
> 　そうしてよ
> と言われてしまいました。

さすがにこれだけじゃ何がしたいのかぜんぜんわかりませ～ん。
さて、今夜もお座敷が待っているのです。
では、さらばガンダム少年。

お礼

すいません。
文章が下手で誤解を与えました。

> ・データ元を別の値に変換してから転記できるならこっちも
> 　そうしてよ
> と言われてしまいました。

今回、教えていただいた
Sｕｂ　名前変換03
を別スレッドで教えてもらったマクロに流用する事になったいきさつを
説明しました。

よって
Sub　TEST03
で達成できましたので、そちらも完成です。

どうもありがとうございました。

補足

どれをベストアンサーにしたらいいのか分かりません。

全てベストアンサーなので、

一番最後をベストアンサーにします。

本当は、もう一個質問を補足で追加して、

回答をもらえばこのカテゴリ内の

「回答の件数が多いスレッド」１位の４４件に並ぶのですが．．．．

でもそんなのは目的ではないので。

別スレッドで質問します。

いろいろとありがとうございました。

回答No.41

merlionXX

おや、2行目からでしたか。

では、

Sub TEST03()
　　With Sheets("Sheet2")
　　　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　　　.Range("G2").Formula = _
　　　　"=IF(ISNA(VLOOKUP(C2,Sheet3!$A:$B,2,FALSE)),""不明"",VLOOKUP(C2,Sheet3!$A:$B,2,FALSE))" '数式入力
　　　　.Range("G2").Copy .Range("G2:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　　　.Columns("G:G").Copy
　　　　.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
　　　　Application.CutCopyMode = False
　　End With
End Sub

それでは、夜の町へ今夜もご出勤！
行ってまいります。

お礼

もうベストアンサーを登録して締めようとした時に
このスレッドの前の教えていただいた完成したマクロの変更依頼が来ました。
あのマクロは、教えていただいた後に、メンテを考慮して
自分で修正しmerlionXXさんに見てもらって（たしかお酒がはいっていた時(^_^.)）
「大丈夫ですよ」と言われて、その後順調でした。
転記元の対象部分が変わっても、転記先が変わっても
対応できるようにしておいたのですが、
今回このスレッドで名前変換を使った物ですから
それを見て、
・データ元を別の値に変換してから転記できるならこっちも
　そうしてよ
と言われてしまいました。

今度こそ、自分だけでと思いましたが駄目でした。(T_T)
このスレッドを閉じていなくて良かったです。

Sub TEST03()

は完璧でした。
ありがとうございました。

回答No.40

merlionXX

> これだとやばくてＨＩＴしない場合は空白で行きたいです。
> もしくは「不明」という文字を転記（代入？）させる事は可能でしょうか？

そうですか、ヤバいですか。
では、これでいかがでしょう？

Sub TEST02()
　　With Sheets("Sheet2")
　　　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　　　.Range("G1").Formula = _
　　　　"=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),""不明"",VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))" '数式入力
　　　　.Range("G1").Copy .Range("G1:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　　　.Columns("G:G").Copy
　　　　.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
　　　　Application.CutCopyMode = False
　　End With
End Sub

空白にしたい場合は、""不明""　を　""""　にしてください。

> もしかして私のＰＣを覗いているのかなと思う時あります。

あはは、それが出来たらほんと回答が楽なんですけどねえ。
せめて画像だけではなく、ファイルもアップできればいいのですが・・・。

お礼

ありがとうございます。

Sub TEST　02

すでに報告済みですが
データが2行目からの為
当たり前ですが
Ｇ１に
「不明」が入ってしまいました。

もう
Sub TEST03
をリリースしてくださいましたね。
すぐ試します。

回答No.39

merlionXX

> シート２のＣ列の値を検索値としてシート３のＡ列をVLOOKUPで検索し
> ＨＩＴしたらシート３の該当行のＢ列の値をシート２のＧ列に転記し

ヒットしないときはC列の値をそのまま表示でしたよね？
ということは、ワークシート関数式でSheet2のG1セルなら
=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),C1,VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))
という式が入ればいいのですね？（もちろん最後は式ではなく値に変換しますが）

ならば前回と同じようにしたいなら

Sub TEST01()
　　With Sheets("Sheet2")
　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　.Range("G1").Formula = _
　　"=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),C1,VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))" '数式入力
　　.Range("G1").Copy .Range("G1:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　.Columns("G:G").Copy 'G列を値に変換
　　.Range("G1").PasteSpecial Paste:=xlPasteValues
　　Application.CutCopyMode = False
　　End With
End Sub

> ファイル名を変更されてもメンテしなくていいように

同じBOOK内ですから、式の中にファイル名は存在しません。
だから名前を変えられても無関係です。

> それはmerlionXXさんと私にしかわかりませんのでm(__)m）

ん？二人だけの秘密？（笑）
それって、ファイル名変更に対応したということ？
それとも何か別にありましたっけ？

お礼

ありがとうございます。

Sub TEST01()
　　With Sheets("Sheet2")
　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　.Range("G1").Formula = _
　　"=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),C1,VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))" '数式入力
　　.Range("G1").Copy .Range("G1:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　.Columns("G:G").Copy 'G列を値に変換
　　.Range("G1").PasteSpecial Paste:=xlPasteValues
　　Application.CutCopyMode = False
　　End With
End Sub

ですが、こちらは条件が違ってまして、
シーと２もシート３もデータが２行目からでした。
（これは基幹システムデータなのでマクロで編集したとかで
　なっているわけではないのでデータ2行目からというのは
　変更できません。）
1行名には項目が入っています。

よって
G1→G2
C1→C2
にしたのですがＥＲＲになりました。
「書式が相違して貼付できません」

.Columns("G:G").Copy 'G列を値に変換

この部分はＧ列全部を選択ですから
ここも修正が必要なのでしょうか？

それとも
G1→G2
C1→C2
は不要な行為なのでしょうか？

申し訳ありません。m(__)m

補足

すいません。
大事な事を書き忘れました。

流用版では、

＞ヒットしないときはC列の値をそのまま表示でしたよね？

こちらは、これだとやばくてＨＩＴしない場合は空白で行きたいです。
もしくは「不明」という文字を転記（代入？）させる事は可能でしょうか？

申し訳ないです。

＞ん？二人だけの秘密？（笑）

ここでかなりの質問をしています。
いろいろな考えの方がいらっしゃいます。

記述をコピペして、今回やりたい事を質問すると、
なぜこういう記述なのか？
という質問がくるかもしれません。
それを説明しなくてはいけなくなるからです。

merlionXXさんは、私の誤記も説明不足も全て察知
（しかも正しい内容で→これ本当にびっくりしてます。
　もしかして私のＰＣを覗いているのかなと思う時あります。）

初めての出会い。　
QNo.6084303
の
ANo.2
2010-08-17 09:07:32

次に初の複数回答
QNo.6145802
2010-08-30 10:43:15
エクセルのマクロ、Modulu、プロシージャ及び記録したマクロの名称

ANo.1
ANo.3
ANo.4
ANo.5

この時も凄く丁寧に説明してくださいましたよね。
あの頃はわからない事がわからい状態でしたので
凄く嬉しかったです。

回答No.38

merlionXX

さて、さきほどの回答をご覧いただいてもうお分かりとは思いますが、この際ですから（笑）簡単に説明すると
With Sheets("集計") '(1)　は、最後のEnd With '(1)と対になっているわけですから全部にかかっていますよね。
つまり、その下の
With .Range("A1") '(2)　
With .Range("A2:O2") '(3)
With .PageSetup '(4)
のドットの前は
たとえば、With Sheets("集計").Range("A1") '(2)　のようにSheets("集計") が略されているわけです。
そして、(2)から(4)のWith~End Withのなかではドットの前に
それぞれ、
Sheets("集計").Range("A1")
Sheets("集計").Range("A2:O2")
Sheets("集計").PageSetup
が略されています。

ですから、ご希望のところで二つにわけるには以下のようになります。

Sub ページ設定前編()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　With .UsedRange.Borders 'データ部分を罫線で囲む
　　　　　　.LineStyle = xlContinuous
　　　　　　.Weight = xlThin
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。・・
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　End With
　　ActiveWindow.Zoom = 75 '画面表示を75%に
End Sub 'ここで分割（別プロシージャーに）

Sub ページ設定後編()
　　With Sheets("集計")
　　　　With .PageSetup '印刷用ページ設定
　　　　　　.PrintTitleRows = "$1:$2"
　　　　　　.CenterFooter = "&P / &N ページ"
　　　　　　.LeftMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.RightMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.TopMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.BottomMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.HeaderMargin = Application.InchesToPoints(0.511811023622047)
　　　　　　.FooterMargin = Application.InchesToPoints(0.196850393700787)
　　　　　　.CenterHorizontally = True '水平方向の中央寄せ
　　　　　　.Orientation = xlPortrait '縦向き
　　　　　　.PaperSize = xlPaperA4 'A4にあわせて
　　　　　　.Zoom = False '自動
　　　　　　.FitToPagesWide = 1 '横を１ページ内に
　　　　　　.FitToPagesTall = False '縦方向は制限なし
　　　　End With
　　End With
End Sub

これでほんとの完了かな？

お礼

ありがとうございます。
プロシージャー２個にして
うまくいきました。

回答No.37

merlionXX

こんにちはガンダムさん。

> 今回教えていただいた記述でも
> WithとEnd　Withだけにすると
> 以下の順番ですがどうしてこうなのか自分で理解ができません。

どのWithとEnd Withがセットなのか、同じ番号を振りました。
よく見てください。

Sub ページ設定02()

　　With Sheets("集計") '(1)

　　　　With .Range("A1") '(2)

　　　　End With '(2)

　　　　With .Range("A2:O2") '(3)

　　　　End With '(3)

　　　　With .PageSetup '(4)

　　　　End With '(4)

　　End With '(1)

End Sub

お礼

ありがとうございました。大変わかりやすかったです。

別件ですが(^_^.)教えていただいたSub名前変換03ですが

Sub 名前変換03()
Dim myBk As String
myBk = ThisWorkbook.Name
With Sheets("集計")
.Columns("F:F").NumberFormatLocal = "G/標準"
.Range("F1").Formula = _
"=IF(ISNA(VLOOKUP(E1,[" & myBk & "]従業員名簿!$A:$B,2,FALSE)),E1,VLOOKUP(E1,[" & myBk & "]従業員名簿!$A:$B,2,FALSE))"
.Range("F1").Copy .Range("F1:F" & .Range("E" & .Rows.Count).End(xlUp).Row)
.Columns("F:F").Copy
.Range("F1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End Sub

全然別のエクセルファイルで（今度は同じBOOK内です。）
シート２のＣ列の値を検索値としてシート３のＡ列をVLOOKUPで検索し
ＨＩＴしたらシート３の該当行のＢ列の値をシート２のＧ列に転記し
シート２のＣ列の値があるまで繰り返すというのに
流用できますでしょうか？（したいです。）
ファイル名を変更されてもメンテしなくていいように
これを流用したいのですが。
集計→シート２
従業員名簿→シート３
記述内のすべての列指定部分のF→G
（F1→G1）
記述内のすべての列指定部分のE→C
(E1→C1)
にしましたが動きません。
やはり流用しない方がいいのでしょうか。

シート３のＢ列は書式が標準で
Ｍ０１、Ｍ０２～Ｍ１９、Ｍ２０という２０種類しか存在しません。
Ａ列は4,500行で書式が標準です。

別スレッドで質問すべきですが
merlionXXさんの記述をそっくりコピペで質問になってしまうので
それはmerlionXXさんに失礼になってしまいますし、
他の回答者さんに「なぜこの方法ですか？」ときっと言われますので。
（このSub　名前変換03はある理由があってこの記述であり
　それはmerlionXXさんと私にしかわかりませんのでm(__)m）

（なお別のエクセルとはQNo.6251880でmerlionXXさんに教えていただいた
　マクロでそれに合流させるつもりです。）

本当にすいません。
LOOP文とエクセルファイル名指定でなら自分でも作成できますが、
この記述を変更する事によってこの記述の意味が理解出きる物ですから。
（本当かな？？？？）
私は今は記述1行ごとにその文が何をするのかコメントを入れています。
（実は名前変換03はまったく意味がわからずコメントが入れられないのです。）

回答No.36

merlionXX

おはようございます、ガンダムさん。
Sub test07() '2000-2003共用
うまくいってよかった！

今日も東京は快晴です。
GX9901ってなんだろうとおもったら・・・・・・。
gx9wxさんは、幼少期はSFアニメ大好き少年だったのかな。
わたしもカラオケでは「科学忍者隊ガチャマンの歌」好きです。
ヾ(=^▽^=)ノ

さて、本日の日課（？）

ページ設定のコード、不要部分と思われるものを削ったり、少しいじってみました。
Zoomはプリンターに影響を受けるので、決めうちではなく横を１ページにおさめるようにしてみました。

Sub ページ設定02()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。・・
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　　　With .PageSetup '印刷用ページ設定
　　　　　　.PrintTitleRows = "$1:$2"
　　　　　　.CenterFooter = "&P / &N ページ"
　　　　　　.LeftMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.RightMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.TopMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.BottomMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.HeaderMargin = Application.InchesToPoints(0.511811023622047)
　　　　　　.FooterMargin = Application.InchesToPoints(0.196850393700787)
　　　　　　.CenterHorizontally = True '水平方向の中央寄せ
　　　　　　.Orientation = xlPortrait '縦向き
　　　　　　.PaperSize = xlPaperA4 'A4にあわせて
　　　　　　.Zoom = False '自動
　　　　　　.FitToPagesWide = 1 '横を１ページ内に
　　　　　　.FitToPagesTall = False '縦方向は制限なし
　　　　End With
　　End With
End Sub

お礼

ありがとうございます。
ちょうどいい事例なので教えてください。

参考書には
・With を使用したら必ずEnd Withを
とは載っていますがそれ以上の事は載っていません。
今回のようにWithがたくさんある場合にいつも疑問です。
私が記述をすると

　「End　Withがありません」　
　「End　Withに対するWithがありません」
とよくエラーになります。
で適当に入れたり削除で、エラーがでなくなったら
ＯＫといい加減にやっています。

今回教えていただいた記述でも
WithとEnd　Withだけにすると
以下の順番ですがどうしてこうなのか自分で理解ができません。

With
With
End With
With
End With
With
End With
End With

また　ページ設定　は2個のプロシージャーにしようと思って
教えていただいた物に付け足した上で分割しようと思いましたが
さらにWithが増加でよくわかりません。
いつもの手で回避できますがそれでは覚えないので
教えてください。お願いします。

Sub ページ設定02()

With Sheets("集計")
.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に

-----ここに以下の記述を付け足し

　'データ部分を罫線で囲む
　　With ActiveSheet.UsedRange.Borders
　　.LineStyle = xlContinuous
　 　.Weight = xlThin
　　.ColorIndex = xlAutomatic
　　End With
-------

.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。・・
With .Range("A1") '表のタイトルをつける
.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
With .Range("A2:O2")
.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
.Interior.ColorIndex = 15 '項目欄を灰色で塗る
End With

----ここに以下の記述をつけたす

　'画面表示を75%に
　ActiveWindow.Zoom = 75

----ここで分割（別プロシージャーに）したい

With .PageSetup '印刷用ページ設定
.PrintTitleRows = "$1:$2"
.CenterFooter = "&P / &N ページ"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.196850393700787)
.CenterHorizontally = True '水平方向の中央寄せ
.Orientation = xlPortrait '縦向き
.PaperSize = xlPaperA4 'A4にあわせて
.Zoom = False '自動
.FitToPagesWide = 1 '横を１ページ内に
.FitToPagesTall = False '縦方向は制限なし
End With
End With
End Sub

補足

すいません。
昨日はＰＣで作業している暇がありませんでした。

よくわかりましたね。
（WEB検索でＨＩＴしますね。）
ガンダムファンでも知らない人がいるマイナーシリーズなんですが。

＞幼少期はSFアニメ大好き少年

すいません。大人になってはまってます。
あのストーリーは子供では理解できません。

＞「科学忍者隊ガチャマンの歌」

私も大好きです。

回答No.35

merlionXX

ごめん、わたしのミスです。
わたしが2000で試せるように修正したときに記述を誤りました。
(///▽///)　赤面

これなら大丈夫だと思います。

Sub test07() '2000-2003共用
　　Dim myRng As Range
　　Dim x As Long, y As Long, z As Long, n As Long, i As Long
　　Dim myAr, myNm()
　　With Sheets("集計")
　　　　Set myRng = .Range(.Range("H1"), .Range("H1").End(xlDown)) 'H列データ
　　　　x = .Range("A1").SpecialCells(xlLastCell).Column + 1 'シート使用範囲の一つ右の列番号
　　　　y = x - myRng.Column 'H列と上記の列の差
　　　　Application.ScreenUpdating = False '画面更新停止
　　　　.Cells(1, x).Value = 1 'x番目列の１行目セルに1を入力
　　　　With myRng.Offset(1, y).Resize(myRng.Count - 1, 1) 'その下に数式入力
　　　　　　.FormulaR1C1 = "=R[-1]C+1+(R[-1]C[-" & y & "]<>RC[-" & y & "])" '連番(+1)設定（区切位置では+2）
　　　　　　.Copy 'コピー
　　　　　　.PasteSpecial Paste:=xlPasteValues '値張り付け（数式を値にした）
　　　　　　Application.CutCopyMode = False
　　　　　　myAr = .Offset(-1).Resize(.Count + 1, 1).Value '配列myArに値を代入（Offsetをもどして）
　　　　　　For i = LBound(myAr, 1) To UBound(myAr, 1) - 1 '配列内で
　　　　　　　　If myAr(i + 1, 1) - myAr(i, 1) = 2 Then '差が2の場合
　　　　　　　　　　ReDim Preserve myNm(n) '配列添字追加
　　　　　　　　　　myNm(n) = myAr(i, 1) + 1 '配列myNmに+1の値を代入
　　　　　　　　　　n = n + 1 'カウント
　　　　　　　　End If
　　　　　　Next i '繰り返し
　　　　　　.Cells(.Count).Offset(1).Resize(UBound(myNm) + 1, 1).Value = Application.Transpose(myNm) '連番の下に配列myNmを入力
　　　　End With
　　　　.Range(.Cells(1), .Cells(1, x).End(xlDown)).Sort Key1:=.Cells(1, x), Order1:=xlAscending, Header:=xlNo 'x番目列基準で昇順に並び替え
　　　　.Columns(x).Clear 'x番目列の内容削除
　　　　z = .Range("H" & .Rows.Count).End(xlUp).Row 'H列最終行取得
　　　　Application.ScreenUpdating = True '画面更新停止解除
　　　　ActiveWorkbook.Names.Add Name:="ExternalData_1", RefersTo:="=" & .Name & "!" & .Range(.Cells(1, "A"), .Cells(z, x - 1)).Address'ExternalData_1拡大
　　End With
End Sub

あしたは定休日ですか。
ゆっくりおやすみください。

お礼

Sub test07() '2000-2003共用

完璧です。
test05の時と同じになりました。
エラーチェックも出ていません。
O列の計算もＯＫです。
データーは3行目になりました。

どうもありがとうございました。

ほぼ完成かな、です。

無事解決で安心して休暇に入れます。

いろいろありがとうございました。

回答No.34

merlionXX

こんにちは。(^o^)/

投稿日時 - 2010-11-04 13:52:32のお礼を見逃してました。
Sub 名前変換03()はうまくいったようですね。
Sub test06() も思ったようになってくれたらよいのですが会社の2000では試せません。

さて、以前の

> もうこのさいですので聞いてしまいます。

が、まだいくつか残ってましたね。

並べ替えは違うでしょうが、その他の作業は、もしこれらの作業を続けてやっているなら、以下ようにしたほうがすっきりすると思います。

Sub このさい聞いちゃった()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　End With
End Sub

・作業の対象を明示する。
・やむを得ない場合以外はSelectしない。
・まとめられるものはまとめて書く。
これらが基本じゃないかなと思います。

わたしもこの際、聞いちゃおうかな。
gx9wxさんのID、gx9wxってどんな意味なんでしょう？

お礼

ありがとうございます。
表の編集が全て終了後に表の装飾として行っています。
Callに分けた部分は
A4用紙に印刷する時の為でしたが別に画面で見ても
影響しないので一纏めでもかまわないです。
特にSub ページ設定内の「ページ設定」より前の部分は
印刷するしないに限らず
装飾なので一纏めがいいです。
（5万行のデーターを印刷する人はいないと思います。
　ページ指定で印刷する人の為です。）

'項目名行の幅をオートフィット
Range("A:A:O:O").EntireColumn.AutoFit
'項目名行をセルの中央へ
Range("A1:O1").HorizontalAlignment = xlCenter
'各列の値を中央に
Range("A:A:K:K").HorizontalAlignment = xlCenter
'データ部分を罫線で囲む
With ActiveSheet.UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'画面表示を75%に
ActiveWindow.Zoom = 75
'印刷用にページ設定をします。
Call ページ設定
------
Sub ページ設定()

'2010年10月6日
'A4にあわせてページ設定を行います。

'1行目にタイトル用の空白行を作成する。
Rows("1:1").Select
Selection.Insert Shift:=xlDown
'項目欄を灰色で塗る
Range("A2:O2").Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
'表のタイトルをつける
Range("A1").Value = "実績一覧表" & Date
Range("A1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With

'印刷用ページ設定
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P / &N ページ"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.196850393700787)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 60
.PrintErrors = xlPrintErrorsDisplayed
End With
End With
End Sub

補足

こんにちは。

＞gx9wxさんのID、gx9wxってどんな意味なんでしょう？

形式番号
GX-9901
機体名
WX
↓
GX9901WXのつもりが
得意の誤記で
gx9wx
になりました。(-_-;)

回答No.33

merlionXX

こんばんは。遅くなりました。
今日は久々に快晴だったので出かけていました。
数値がテキスト形式云々の警告が表示されるのはセル内の数字が文字列として保存されてるか、アポストロフィで始まる場合です。エラーじゃないです。
でも、それが表示されることで何か問題でも？

これ2000では出ないんです。今日は自宅だったので2003でこれを再現できました。
でも、なぜ途中からでるのか？
テストの結果、取り込みデータが1万行、空白行を挿入して1万1千行の場合、増えた1千行にその表示がでるようですね。当初の1万行範囲は「外部データの取り込み」でテキストで取り込んだためその範囲は表示がでないのかも。
試行錯誤の結果、当初取り込んだ行以外にも表示させないためには以下のコードにしてみてくだい。

Sub test06() 'Office2000併用
　　Dim myRng As Range
　　Dim x As Long, y As Long, z As Long, n As Long, i As Long
　　Dim myAr, myNm()
　　With Sheets("集計")
　　　　Set myRng = .Range(.Range("H1"), .Range("H1").End(xlDown)) 'H列データ
　　　　x = .Range("A1").SpecialCells(xlLastCell).Column + 1 'シート使用範囲の一つ右の列番号
　　　　y = x - myRng.Column 'H列と上記の列の差
　　　　Application.ScreenUpdating = False '画面更新停止
　　　　.Cells(1, x).Value = 1 'x番目列の１行目セルに1を入力
　　　　With myRng.Offset(1, y).Resize(myRng.Count - 1, 1) 'その下に数式入力
　　　　　　.FormulaR1C1 = "=R[-1]C+1+(R[-1]C[-" & y & "]<>RC[-" & y & "])" '連番(+1)設定（区切位置では+2）
　　　　　　.Copy 'コピー
　　　　　　.PasteSpecial Paste:=xlPasteValues '値張り付け（数式を値にした）
　　　　　　Application.CutCopyMode = False
　　　　　　myAr = .Value '配列myArに値を代入
　　　　　　For i = LBound(myAr, 1) To UBound(myAr, 1) - 1 '配列内で
　　　　　　　　If myAr(i + 1, 1) - myAr(i, 1) = 2 Then '差が2の場合
　　　　　　　　　　ReDim Preserve myNm(n) '配列添字追加
　　　　　　　　　　myNm(n) = myAr(i, 1) + 1 '配列myNmに+1の値を代入
　　　　　　　　　　n = n + 1 'カウント
　　　　　　　　End If
　　　　　　Next i '繰り返し
　　　　　　.Cells(.Count).Offset(1).Resize(UBound(myNm) + 1, 1).Value = Application.Transpose(myNm) '連番の下に配列myNmを入力
　　　　End With
　　　　.Range(.Cells(1), .Cells(1, x).End(xlDown)).Sort Key1:=.Cells(1, x), Order1:=xlAscending, Header:=xlNo 'x番目列基準で昇順に並び替え
　　　　.Columns(x).Clear 'x番目列の内容削除
　　　　z = .Range("H" & .Rows.Count).End(xlUp).Row 'H列最終行取得
　　　　Application.ScreenUpdating = True '画面更新停止解除
　　　　ActiveWorkbook.Names.Add Name:="ExternalData_1", RefersTo:="=" & .Name & "!" & .Range(.Cells(1, "A"), .Cells(z, x - 1)).Address
　　End With
End Sub

取り込んだ外部データ（ExternalData_1）の範囲を拡張してみました。
こんなこと今までしたことないので、何か他に問題が起きるかどうかなんともいえませんが。

ではまた明日！

お礼

ありがとうございます。
うまく説明できないのですが、
こんな感じです。

【test06をもらう前】

1.CSVインポート後

行
1　データー行みかん
2　データー行いちご
3　データー行りんご
4　データー行みかん
5　データー行いちご

2.項目行挿入

行
1　項目行
2　データー行みかん
3　データー行いちご
4　データー行りんご
5　データー行みかん
6　データー行いちご

3.testO5が動作後

行
1　項目行
2　空白行（必ず）
3　データー行みかん
4　データー行みかん
5　空白行
6　データー行いちご
7　データー行いちご

4.品別集計05が動作

行
1　項目行
2　空白行
3　データー行みかん→セルO3に値
4　データー行みかん→セルO4に値
5　空白行
6　データー行いちご→セル06に値
7　データー行いちご→セル07に値

↓↓↓

【test06を使用した場合】

1.CSVインポート後

行
1　データー行みかん
2　データー行いちご
3　データー行りんご
4　データー行みかん
5　データー行いちご

2.項目行挿入

行
1　項目行
2　データー行みかん
3　データー行いちご
4　データー行りんご
5　データー行みかん
6　データー行いちご

3.testO6が動作後

行
1　項目行
2　データー行みかん
3　データー行みかん
4　空白行
5　データー行いちご
6　データー行いちご

4.品別集計05が動作

行
1　項目行
2　データー行みかん→セルO2に値がない場合がある
3　データー行みかん→セルO3に値
4　空白行
5　データー行いちご→セルO5に値
6　データー行いちご→セルO6に値

明日５日は会社自体がなぜか定休日です。m(__)m

補足

ありがとうございます。

>でも、それが表示されることで何か問題でも？

セルの書式設定が列の全行が「文字列」なのに、
エラーチェックマークがある行と無い行が
あって気持ち悪かったので。
あとこれは実績データとして保存していきます。
エラーチェックマークがあるセルは！をクリックして
「数値にする」をクリックすると
0010　→　10
になってしまうので、そういう作業はさせたくないので
エラーチェックマークははずしたいと思いました。

　エクセルのツール→オプション→エラーチェック→
　→ルール→文字列として保存されている数値
のチェックをはずす手段も考えましたが
本当のエラーが発見されないのでやめました。

Sub　test06　を試しました。

全行エラーチェックマークは消えました。＼(^o^)／
ですが一つ疑問が。

この空白行を入れるマクロはバージョン05以前は
動作終了後は必ずデータ開始行は3行目になります。
それは以下の処理順だからです。↓
　１．CSVインポート時→データ開始１行目
　２．1行目に項目名を入れる行を挿入
　３．データ開始は2行目になる
　４．空白行を入れるマクロで
　　項目行である1行目とデータ開始行の2行目は
　　当然違う値だから1行目と2行目の間に空白行が入ります。
結果データは開始行は3行目になっています。
そこで例のO列の計算マクロが走ります。
　５．Sub 残数計算3（Sub 品別集計05です）
　　↓↓
'2010年10月26日
'残数計算　M列を入庫、N列を出庫としO列に残数を転記する
'L列に値がある場合は計算しないで上の行をそのまま転記
'計算対象データは3行目から
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
End Sub

ですがSub　test06で空白行を入れた場合はなぜか
項目行の1行目とデーター開始後の行の間には空白が入らない為、
データ開始は2行目からとなります。
となりますと、
　Sub 残数計算3(Sub 品別集計05）は
　　With Range("O3:O" & i)
という記述なので不安です。

ちなみにCSVの取込データによってですが
データ開始行のO列に計算値が入る場合、入らない場合が有りました。
（該当セルはO2になります。）

そもそもは上記NO.1～NO.4の状態を説明をして
Sub 残数計算3(Sub 品別集計05）を作成していただきました。
よって回答A-NO.14で
>データは３行目からとお書きだったじゃないですか。
>２行目からがデータならほんのちょっとの手直しでいいですが、
>１行目からデータでは
>数式"=IF(ISBLANK(RC[-4]),FALSE,SUM(R[-1]C,RC[-2])-RC[-1])"
>が成り立たず、エラーになるはずです。
>これを、１行目にもっていけないのはわかりますよね、
>O1セルより上にセルはないんですから。

という指摘もいただきまして現在もNO.1～NO.5の順番の記述です。
（その後データ開始1行目からのバージョン　Sub 品別集計06
　　も作成していただきました。）

このSub 品別集計06が存在しますので私の記述の順番を

　１．CSVデータ取込→データ開始1行目
　２．空白行挿入Sub　test06→データ開始1行目のまま
　３．Sub 品別集計06（05→06　データ1行目バージョンに変更）
　　　→データ開始は１行目のまま
　４．1行目に項目欄挿入←これは２,３終了後に行う様に変更

に変更が可能です。こうした方が無難なのでしょうか？