[[20050822211423]] 『オートフィル後の…』(プリン) ページの最後に飛ぶ

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

 

『オートフィル後の…』(プリン)

 問題が変わってきたので改めて新規質問します。

 http://ryusendo.no-ip.com/cgi-bin/upload/src/up0344.xls

 参考に現在の状況をアップします。

 オートフィルで条件抽出後抽出されなければ最下行に転記するのは可能になりました。
 今までは条件に一致した行が出てきたときはセルAからセルLまでを転記せずにセル
 Mにシート1のセルMとシート2の抽出されたセルMに和を転記するということでした。

 今回の問題は条件に一致した場合に抽出された行の行番号を習得してシート1から
 シート2のその行全てに転記するということなんですが…
 行番号の習得がうまくいかず困っています。
 最下行に転記されたり消えてしまったりで

 やはりマクロですべての条件を検索して転記するのは無理なのでしょうか?
 オートフィルで抽出した行の行番号の参照がおかしいのでしょうか? 
 +1をつけても−1をつけてもうまくいきません。

 どちら様か教えてください プリン

 もともとが私のコードのようですね。
提示されたファイルのコードを再掲します。
 
 Sub ボタン1_Click()
     Dim i As Long
     Dim v As Long
     Dim MyCount As Long
         If vbNo = MsgBox("データを登録します。OK?", vbQuestion + vbYesNo, "確認") Then
             Exit Sub
         End If
         For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
             'ここに処理を入れる。
             With Worksheets("在庫表")
                 i = .Range("A65536").End(xlUp).Row + 1
                 v = .Range("A65536").End(xlUp).Row
                 Rem 在庫表データ範囲A列〜I列データ範囲でオートフィルタ
                 Rem 各フィールドでフィルタを実行
                 For MyCount = 1 To 12
                     .Range("A1:M" & i - 1).AutoFilter _
                         Field:=MyCount, _
                         Criteria1:=Cells(6, MyCount).Value
                 Next MyCount
                 Rem オートフィルタ後の可視セルをカウント↓
                 If .Range("A1:A" & i - 1).SpecialCells(xlCellTypeVisible).Count = 1 Then
                     Rem フィルタの結果、可視セルが見出し行のみになった(重複レコードがない)場合は
                     Rem ↓ For〜Nextを実行して転記。
                     For MyCount = 1 To 13
                         .Cells(i, MyCount).Value = Cells(6, MyCount).Value
                     Next MyCount
                 ElseIf .Range("A1:A" & i - 1).SpecialCells(xlCellTypeVisible).Count = 2 Then
                     Rem フィルタの結果、可視セルが2行のみになった(重複レコードがひとつ)場合は
                     Rem ↓ For〜Nextを実行して転記。
                     For MyCount = 1 To 13
                         .Cells(v, MyCount).Value = Cells(6, MyCount).Value
                     Next MyCount
                 End If
                 Rem オートフィルタ解除
                 .Cells.AutoFilter
             End With
             Sheets("Sheet1").Select
             Rows("6:6").Select
             Selection.Delete Shift:=xlUp
         Next C
 End Sub
 
プリンさんのやりたいことがわかっているわけではない、
かつ詳細なデバッグはしていない状態ではありますが、
> 行番号の習得がうまくいかず困っています。
  
For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
 
変数Cをループの中で利用しておらず、単にループ回数を規定するつもりで
For Each C In ・・・としているのは誤った使い方です。
ここで範囲を取得してFor Eachでループし、なおかつ、その範囲の
セルを行削除してしまうのは動作がおかしくなつ原因になります。
VBEのステップインで実際の行数とループの回数を確認してみてください。
ループ先頭に戻るたびに削除した分の行数が減るので、期待した回数には
なりません。
For Each C In ・・・とするのであれば
6行目をループ内で削除しない。
下記のようなオブジェクト変数Cを基準とした取得とする。
    Criteria1:=Cells(C.Row, MyCount).Value
    .Cells(i, MyCount).Value = Cells(C.Row, MyCount).Value
Next C の後にまとめて転記した範囲を削除する、などとします。
 
i = .Range("A65536").End(xlUp).Row + 1
これは新規追加したい行位置を取得するものである、つまり、
Worksheets("在庫表")の最下行の一行下の行番号だからよいとしても、
 
v = .Range("A65536").End(xlUp).Row
は現在の実行位置ではWorksheets("在庫表")の最下行でしかありません。
つまり、オートフィル「タ」で抽出した行に転記するのを意図している
のであれば、オートフィル「タ」実行後にこのコードを実行しないと、
間違った行(データ最下行)に転記していることになります。
 
あと細かいけど、Cも変数なので As Range で宣言しといてね。
(みやほりん)

 (みやほりん)様、ご教授ありがとうございます。
 再度ファイルを更新しました。

http://ryusendo.no-ip.com/cgi-bin/upload/src/up0345.xls

 アップしたファイルのシート1に6行目に新規でない入荷製品、7行目に新規製品
 があります。
 オートフィルで検索するとシート(在庫表)の7行目にヒットし表示されます。
 問題はここからで、

 >v = .Range("A65536").End(xlUp).Row
 >は現在の実行位置ではWorksheets("在庫表")の最下行でしかありません。
 >つまり、オートフィル「タ」で抽出した行に転記するのを意図している
 >のであれば、オートフィル「タ」実行後にこのコードを実行しないと、
 >間違った行(データ最下行)に転記していることになります。

 とあるように現状では察しの通り意図する7行目ではなく15行目に転記します。
 そもそも私が考えていたのはフィルタを使いデータがあった場合はシート1の
 M6とシート2のフィル後のM?の和をそのM?に書き込む。
 また新規データ(フィルで出てこない)の場合は最下行に書き込むというものでした。
 それが出来ないのでせめて上書きくらい出来るかなという甘い考えが…現状を生み
 ただ今ドツボです

 来週からデータが膨大に増えるのでその前に手入力でなく自動化出来ないものかと
 なおかつ、データ量から容量も大変なのでマクロで簡略化できないかと考えたのが
 甘い考えでした。

 For Each だと途中で止まるので←自分で何故か?理解できてない…
 ので現在DO LOOPで一連の作業をデータがなくなるまで繰り返そうかと考えまたハマリ!

 >                    For MyCount = 1 To 13
 >                    Next MyCount
 >                        .Cells(v, MyCount).Value = Cells(6, MyCount).Value
 >                End If

 フィル後がどこだかわからないので上記のようにしてみたらとんでもない結果になりました

プリン


 細かい話ですけども、混同されているようなので……用語について
 
「フィル」とは
http://www.microsoft.com/japan/users/tips/Excel/132.aspx
http://dictionary.goo.ne.jp/search.php?id=exej0127220-00000-00000-00000&kind=ej&mode=5
「フィルタ」とは
http://office.microsoft.com/ja-jp/assistance/HP052611321041.aspx 現在参照不可
http://dictionary.goo.ne.jp/search.php?id=exej0127310-00000-00000-00000&kind=ej&mode=5
 
 >フィル後がどこだかわからないので上記のようにしてみたらとんでもない結果になりました
おそらくオートフィルタ機能の事を指しているのだろうとは想像はできますが、
フィルといわれると別の機能のことかと思ってしまい、話が見えにくいです。
 
なので、それとなくみやほりんさんは
オートフィル「タ」
と強調してくれてるわけです。
回答ではなくて失礼。

 追記:前回までの流れ
[[20050819081450]]『データの転記なのですが…』(プリン) 

 更に追記:もうちょい補足
 
 >For Each だと途中で止まるので←自分で何故か?理解できてない…
 
↑この回答が↓これです。

 >変数Cをループの中で利用しておらず、単にループ回数を規定するつもりで
 >For Each C In ・・・としているのは誤った使い方です。
 >ここで範囲を取得してFor Eachでループし、なおかつ、その範囲の
 >セルを行削除してしまうのは動作がおかしくなつ原因になります。
 >VBEのステップインで実際の行数とループの回数を確認してみてください。
 >ループ先頭に戻るたびに削除した分の行数が減るので、期待した回数には
 >なりません。
 >For Each C In ・・・とするのであれば
 >6行目をループ内で削除しない。
 >下記のようなオブジェクト変数Cを基準とした取得とする。
 >    Criteria1:=Cells(C.Row, MyCount).Value
 >    .Cells(i, MyCount).Value = Cells(C.Row, MyCount).Value
 >Next C の後にまとめて転記した範囲を削除する、などとします。
 
(ご近所PG)

 素人の癖に手を出して…とお怒りでしょう。すみません
 パソコンも人間も一緒ですね。文字ひとつ間違える(足りない)だけで
 気持ちも意味も伝わりませんよね。申し訳ないです (ご近所PG)様

 >For Each だと途中で止まるので←自分で何故か?理解できてない…

 これは転記したあとにその行を削除し又次の行を転記する…というイメージでして
 たぶん(みやほりん)様のご解答は一行を転記する作業のループを指しているのかと
 考えていましたので(実際に指摘通り1列の転記で削除が終わっていた)

 実際に画像やファイルで質問しないとやはり難しいですね。
 いつも諦めてしまい何も前へ進まないのでこのファイルは完成させたいと思います。

 >アップしたファイルのシート1に6行目に新規でない入荷製品、7行目に新規製品
 >があります。
 >オートフィルで検索するとシート(在庫表)の7行目にヒットし表示されます。
 >問題はここからで、

 >>v = .Range("A65536").End(xlUp).Row
 >>は現在の実行位置ではWorksheets("在庫表")の最下行でしかありません。
 >>つまり、オートフィル「タ」で抽出した行に転記するのを意図している
 >>のであれば、オートフィル「タ」実行後にこのコードを実行しないと、
 >>間違った行(データ最下行)に転記していることになります。

 >とあるように現状では察しの通り意図する7行目ではなく15行目に転記します。
 >そもそも私が考えていたのはフィルタを使いデータがあった場合はシート1の
 >M6とシート2のフィル後のM?の和をそのM?に書き込む。
 >また新規データ(フィルで出てこない)の場合は最下行に書き込むというものでした。

 上記の動作が出来るまでご教授お願いします。意味を考えながら変更してみます。
 プリン

 ご近所PGさん、フォローありがとうデス。
 
 >For Each だと途中で止まるので←自分で何故か?理解できてない…
この点を解説しておきましょうか。
 
最初のコードでは For Each C in ・・・・でループの基準を
Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
というセル範囲としています。
 
仮に最初の対象セルがM6:M9の範囲だとします。セル数は4。
が、 For〜Next C の間のコードでは
6行目のデータをフィルタ後の在庫表シートへ転記、しかる後に
6行目を削除、としてますので、ループ基準のセル範囲は利用していません。
すると次のような現象が。
 
M6:M9 4セル(=ループ予定回数)でスタート
一回目 >6行目削除 >対象範囲 M6:M8 3セル − ループ回数1=2 (処理が残っていると判断) 
二回目 >6行目削除 >対象範囲 M6:M7 2セル − ループ回数2=0 (処理が終了したと判断)
 
基準とした対象範囲が減少(移動)してしまっているので、ループが途中で終わり、
この例では2行(元の範囲の8行目、9行目)が残ります。
つまり、ループ中に変数C の対象となるセル範囲が変動するような書き方をしては
いけない、と言うことです。 
 
この点についての対処は先に書いたとおり。
(みやほりん)

 内容をちょっと見たので、自分も思う所をアドバイス程度に。
 
以下について注目すると
    Do
        If Worksheets("Sheet1").Range("A6:M6").SpecialCells(xlCellTypeBlanks).Count = 13 Then Exit Do
        (略)
    Loop
A6:M6が全てブランクだったら処理終了、と考えてます。
このループが正しく動作する為には、「処理が終わった行は削除する」と言う前提が必要になります。
 
で、次に上記ループの内部にある
以下について注目すると
        For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
            'ここに処理を入れる。
            (略)
        Next C
M6からM列の最下行までを処理範囲と考えてますよね。
このループが正しく動作する為には、「行が増えたり減ったりしない事」と言う前提が必要になります。
 
そして処理の中で行を削除している場所がありますが、それが記述されているのは何処なのか、と見て見ると
        For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
            'ここに処理を入れる。
            (略)
            Sheets("Sheet1").Select
            Rows("6:6").Select
            Selection.Delete Shift:=xlUp
        Next C
と、行が増えたり減ったりしない事が前提であるループの中で、行を減らす処理が書かれているわけです。
 
なんか、似たような二つのループの考え方が、ごちゃ混ぜになってしまってます。
ここを一度整理して見ると、何かしら見えてくるのではと思います。
(ご近所PG)

 昼休み中に新たなブックを覗いてみました。
ロジックの整理をしてみるとこんな感じでしょうか。
心配性の私はやはり重複登録の場合を想定してしまう。(みやほりん)
  
 Sub ボタン1_Click()
     Dim i As Long
     Dim C As Range
     Dim Flag As Boolean
     Dim MyCount As Long
         If vbNo = MsgBox("データを登録します。OK?", vbQuestion + vbYesNo, "確認") Then
             Exit Sub
         End If
         If Worksheets("Sheet1").Range("a6:M6").SpecialCells(xlCellTypeBlanks).Count = 13 Then Exit Sub
         For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
             Flag = True  '【修正箇所】
             'ここに処理を入れる。
             With Worksheets("在庫表")
                 i = .Range("A65536").End(xlUp).Row
                 Rem 在庫表データ範囲A列〜I列データ範囲でオートフィルタ
                 Rem 各フィールドでフィルタを実行
                 For MyCount = 1 To 12
                     .Range("A1:M" & i).AutoFilter _
                         Field:=MyCount, _
                         Criteria1:=Cells(C.Row, MyCount).Value
                 Next MyCount
                 Rem オートフィルタ後の可視セルをカウント↓
                 If .Range("A1:A" & i).SpecialCells(xlCellTypeVisible).Count = 1 Then
                     Rem フィルタの結果、可視セルが見出し行のみになった(重複レコードがない)場合は
                     Rem ↓ i に 1を加算
                     i = i + 1
                 ElseIf .Range("A1:A" & i).SpecialCells(xlCellTypeVisible).Count = 2 Then
                     Rem フィルタの結果、可視セルが2行のみになった(重複レコードがひとつ)場合は
                     Rem ↓ フィルタされた行を取得
                     i = .Range("A65536").End(xlUp).Row
                 Else
                     MsgBox "重複登録があります"
                     Flag = False
                 End If
                 Rem ↓ For〜Nextを実行して転記。
                 If Flag Then
                     For MyCount = 1 To 13
                         If MyCount = 13 Then
                         .Cells(i, MyCount).Value = .Cells(i, MyCount).Value + Cells(C.Row, MyCount).Value
                         Else
                         .Cells(i, MyCount).Value = Cells(C.Row, MyCount).Value
                         End If
                     Next MyCount
                     Rows(C.Row & ":" & C.Row).ClearContents
                 End If
                 Rem オートフィルタ解除
                 .Cells.AutoFilter
             End With
         Next C
  End Sub

 貴重なお時間を使用しての皆様のご教授本当にありがたく感謝いたします。
 私も考えながら整理し以下のようにごちゃごちゃになりました(笑

Sub ボタン1_Click()

    '変数の宣言
    Dim i As Long
    Dim C As Variant
    Dim MyCount As Long
        '確認用のメッセージボックスの表示
        If vbNo = MsgBox("データを登録します。OK?", vbQuestion + vbYesNo, "確認") Then
            'NOで終わる
            Exit Sub
        End If
        Do '繰り返し処理をさせるためのループ処理
           'シート1の6行目が空白行(データがなくなったらループを終わる↓
            If Worksheets("Sheet1").Range("a6:M6").SpecialCells(xlCellTypeBlanks).Count = 13 Then Exit Do
            For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))
            '1から13のセルを繰り返し転記させるためのFor Each C…Next C
            With Worksheets("在庫表") 'シート2の作業を対象とするWithステートメント
                '変数のステートメント
                i = .Worksheets("在庫表").Range("A65536").End(xlUp).Row + 1
                '在庫表データ範囲A列〜L列データ範囲でオートフィルタ
                For MyCount = 1 To 12 '変数MyCountのステートメント
                    '各フィールドでフィルタを実行
                    .Range("A1:M" & i - 1).AutoFilter Field:=MyCount, Criteria1:=Cells(C.Row, MyCount).Value
                Next MyCount 'MyCount指定回数フィルタを実行
                'オートフィルタ後の可視表示セルをカウント↓
                    If .Range("A1:A" & i - 1).SpecialCells(xlCellTypeVisible).Count = 1 Then
                    '↑フィルタの結果、可視セルが見出し行のみになった(重複レコードがない)場合は
                        '↓ For〜Nextを実行してデータ最終行の下に新規に全てのデータを転記。
                        For MyCount = 1 To 13 '変数MyCountのステートメント
                            .Cells(i, MyCount).Value = Cells(C.Row, MyCount).Value
                        Next MyCount 'MyCount指定回数転記を実行
                    ElseIf .Range("A1:A" & i - 1).SpecialCells(xlCellTypeVisible).Count = 2 Then
                    '↑フィルタの結果、可視セルが2行になった(重複レコードがひとつ)場合は
                        '↓ For〜Nextを実行して重複レコード上に上書き転記。
                        For MyCount = 1 To 13 '変数MyCountのステートメント
                            .Cells(i - 2, MyCount).Value = Cells(C.Row, MyCount).Value
                        Next MyCount 'MyCount指定回数転記を実行
                    '1行分の転記作業の終了
                    End If
            'Withステートメントの終わり
            End With
            'For Eachに戻る
            Next C
                'オートフィルタ解除
                Worksheets("在庫表").Cells.AutoFilter

            'シート1の6行目をアクティブにする
            Sheets("Sheet1").Rows("6:6").Select
            'アクティブなセル領域を削除する
            Selection.Delete Shift:=xlUp
        'Doに戻る
        Loop
 'マクロの終了
 End Sub

 結局二種類のループの意味のわからないまま(というよりFor Each C… が止まるので
 自分でDo …を付け足したのがそもそもの過ちなんですね。

 結局整理した上記もデバッグの嵐で…重複登録の場合M列の和(足し算)も頭では
 足し算じゃないかと簡単に考えてもコードはわからないから上書きでいいや」と
 諦める始末… 

 (ご近所PG)様 (みやほりん)様のご意見を参考にもう一度書き直して見ます。
 何度も何度もご意見ありがとうございます。 意味のわからないことは理解するまで
 調べてそれでもわからないことはまた申し訳ないですがお聞きしたいと思います。
 プリン

 まず、すばらしいの一言に尽きます。私は4日も5日も何をしていたのでしょう?
 はじめのIf文で変数iをきちんと定義して次のIf文でカウントして条件分岐し書き込む
 すばらしいです!いかに私が無茶苦茶にしていたか…お恥ずかしい限りです。
 出来た、というより完璧に作っていただいた。有難く利用し、またどんどんトライして
 自分のものにしていきたいと思います。

 このファイルはまだまだやりたいことがあるので自分の力で完成に近づけて行きたいと
 思います。(もちろん過去ログと単語検索は欠かしませんが…笑)

 本当にありがとうございました! プリン

 [プリン]さん、もし見ていてたら、修正願います。
一部 間違っておりましたので、前掲のコードを修正しておきました。
Flag = True
ですが、'【修正箇所】という部分へ位置修正してください。
修正前は For Each C・・・より前にありましたが、
その後Trueを代入するところがない(ずっとFalse)ので
一回重複があるとその後の行が転記出来なくなってしまいます。
検証不足で申し訳ありません。
(みやほりん)

 難しいですね。追記ありがとうございます。
 重複以降ずっとFalseでForのループを繰り返すということでしょうか?
 上にあるか下にあるかの違いですがプログラムってほんとに正確でおそろしい…
 ただ今、第二段階で格闘中です。
 作りながら読み返しながらコメントつけながらぶつぶつ言っています。
 ありがとうございます!(みやほりん)様へ
 プリン

コメント返信:

[ 一覧(最新更新順) ]


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