[[20050819081450]]　『データの転記なのですが…』（プリン）　ページの最後に飛ぶ

『データの転記なのですが…』（プリン）

過去ログからの応用で少しづつですが進歩？
ですが本を調べてもログを検索してもわからないことがあるので教えてください。

Sub ボタン1_Click()
Dim i As Long

     Dim MyCount As Long

     If vbNo = MsgBox("データを登録します。ＯＫ？", vbQuestion + vbYesNo, "確認") Then
         Exit Sub
     End If

     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を実行して転記。
             MyCount = 13
                 .Cells(v, MyCount).Value = Cells(6, MyCount).Value

         End If

         Rem　オートフィルタ解除
         .Cells.AutoFilter
     End With
End Sub

上記の場合データがあった場合上書きされてしまうので上書きではなくシート１の13番目の値とシート2のフィルター後の13番目の値を合計してシート２の13番目に求める方法を教えてください

プリン

 なかなかレスが付きませんね。
 もし可能であれば、簡単なサンプルを作って以下のramrunさんのアップローダに
 ファイルをアップしてみては如何でしょうか。
http://ryusendo.no-ip.com/cgi-bin/upload/upload.html
　
 そうすれば回答者の方の手間がかなり省けて回答が付きやすいかと思います。
　
※個人名、固有の会社名等不都合のある部分（プロパティ内も含め）は消去しておいてください。

 （川野鮎太郎）

アップしました。
（川野鮎太郎）様ご意見ありがとうございます。
現在は書き込んだら削除するようにしました。が…ループで繰り返そうかと思っているのですが空白セルになったらループを抜ける方法を勉強中です。

どちら様か宜しくお願いします。

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

プリン

 完全に理解していないかもしれませんので違うかも・・・。
 在庫表シートのフィルタされた行のケース数に足し合わせていくだけですか？
 .Cells(v, MyCount).Value = Cells(6, MyCount).Value　の部分を

 こうしたらどうなりますか。
 .Cells(v, MyCount).Value = .Cells(v, MyCount).Value + Worksheets("Sheet1").Cells(6, MyCount).Value

 それとも現在の質問はループ処理かな・・・？(^_^A;

 ループ処理はこんな感じです。
Sub MyLoop()
    For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))

    'ここに処理を入れる。

    Next C
End Sub

 （川野鮎太郎）

早々のご指導ありがとうございます。
買出しで返事が遅くなりました。
意図したいのは
データをフィルタで参照しない場合は追加しあった場合は重複しないで発見したデータに数量だけ追加する。
さらに複数行あるのでひとつの処理が終わったらその行を削除し空白行になるまで繰り返す。ようはシート１のデータをすべて処理するわけですが丸二日本とヘルプとこちらの単語検索と過去ログでここまでしかできませんでした。
少しいただいた上記の内容を勉強してみます。
自分で記録して眼に見えるマクロはわかるのですがそうでない頭でこうしたいというマクロがご指摘のとおりの不完全さになりますね。
いつもありがとうございます。また詰まったら書き込みさせていただきます。

プリン・・・元メープル

 >こうしたらどうなりますか。
 >.Cells(v, MyCount).Value = .Cells(v, MyCount).Value + Worksheets("Sheet1").Cells(6, MyCount).Value

やってみましたがフィルタされた行でなく、シート２の最下行のデータにプラスされてしまいます。なぜでしょう？

 >ループ処理はこんな感じです。

 >Sub MyLoop()
 >  For Each C In Range(Worksheets("Sheet1").Range("M6"), Worksheets("Sheet1").Range("M65536").End(xlUp))

 >  'ここに処理を入れる。

 >  Next C
 >End Sub

ループもなぜか途中で止まってしまうのですが？
必ず最終の一行が残ってしまいます。途中でもなぜか処理が終わっていないのに何行か残してループを抜けてしまいます。

とりあえず私はシート２から何行かコピーしてきてシート１に貼り付けて様子を見たのですが…

untilやwhileを使用しないdo loopで強制にループさせてexitdoにシート１の参照結果がspecialcells(xlcelltypeblanks)だったら抜けるというのは？

抜けなくなったらどうしようとまだやっていませんが(^_^A;
あと少しってなかなかうまくいきませんね。所詮一夜漬けのアマチュアだから…
ご指導いただけますでしょうか？

お願いします　プリン

 途中見てません。一点だけ。

 >抜けなくなったらどうしようとまだやっていませんが(^_^A;
もし永久ループに陥ったら、Escキーでコードを実行を中断できます。
あまり恐れず、思ったとおりに記述して実行してテストテスト。
動きがおかしいな？と思った部分にはブレークポイントを置いてコードを止めて
F8キーでステップ実行。
どうしても実行するのが怖かったら、
実行する前にそのファイルのバックアップを取っておけば必ずその時点までは戻れます。
（ご近所PG）デバッグの仕方（←メモ書き）

 私もよく見てませんが、気になったとこを一点だけ、、、
 >Rem 在庫表データ範囲A列～I列データ範囲でオートフィルタ
 >Rem 各フィールドでフィルタを実行
 >For MyCount = 1 To 12
 >.Range("A1:M" & i - 1).AutoFilter _
 >                        Field:=MyCount, _
 >                        Criteria1:=Cells(6, MyCount).Value
 >Next MyCount
 これはちょっと無理があるんじゃないかと思います。
 私なら、ユニークな主キーを作ってそれで管理すると思います。
 重複というのを何をもって重複しているかとみるかですよね。
 マクロだけでするのが必ずしも有効的な方法とはかぎりませんよ。
 例えば、
 =A1&B1&C1
 こんな数式をセットしておけばそうそう重複することもないでしょうし、
 重複さえしていなければ後の操作が楽になりますからね。
 作業列や数式を使ってExcelの本来の機能で抽出する。
 シンプルIsベストですよ。(^^;
 どうでしょうか？
あっ、それからここに書き込む時は文節の先頭に半角のスペースを空けるといいですよ。
←ここです。ここに半角のスペースを入力してみてください。
編集画面で見比べていただければすぐにわかります。
（SoulMan）

 （ご近所PG）デバッグの仕方（←メモ書き）様、ご意見ありがとうございます。
 早々やってみて何回もはまりましたがループに関してはやっと出来たみたいです
 とりあえずシート１の６行目が１３列空白なら抜ける？を意識して…

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

 （SoulMan）様のご意見は編集中に発見したのでこれから見てみますが
 数式をどこにどう入れるのか？わけわかりません…
 あとは上記のフィルタで同じアイテムがあった場合は同じアイテムの
 最終セルの数量にプラスし

 なかった場合はそっくりシート２に転記するという作業のみ！

 そっくり転記は出来るようになり、検索したものに同じアイテムがある場合は
 上書きなら出来るのに足したり引いたりがうまくいきません。

 一応現状をアップしました。ご意見お待ちします　プリン

 一応私の考える作成中のファイルのイメージとは
 １２の条件セル全てが一致したセルに数量を足し引きする（今回は足す）
 一致したセルがない場合は新規として追加する。
 上記の動作はシート１からシート２への転記
 これからの取り組みは上記の点とシート２を順番に並べる。

 こんな感じです　プリン

 勘違いしていたらすみません…
 シート１とシート２に関数や数式を６５５３６まで入力したらとんでもないことに
 なったので一切を苦手なマクロでやってみようと思いました。
 >（SoulMan）様

 プリン

 >１２の条件セル全てが一致したセルに数量を足し引きする（今回は足す）
なので12フィールドをすべてフィルタするのではなくて
例えば↓こんな数式をN列に入力しておくのはどうですか？とご提案しているのです。
=A2&B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&L2&M2
ぱっとみですが行位置がお知りになりたいようなので
このN列だけを対象にMATCHで検索しても同じことですよね？
どうでしょうか？
Option Explicit
Sub てすと()
Dim x As Variant
Dim Wh1 As Worksheet
Dim wh2 As Worksheet
Dim i As Long
Set Wh1 = Sheets("Sheet1")
Set wh2 = Sheets("在庫表")
For i = 6 To Wh1.Range("A65536").End(xlUp).Row
    x = Application.Match(Wh1.Cells(i, "N").Value, wh2.Range("N:N"), 0)
    If Not IsError(x) Then
        MsgBox x & "行目です。"
    Else
        MsgBox "一致するデータはありません。"
    End If
Next
Set Wh1 = Nothing
Set wh2 = Nothing
End Sub
（SoulMan）

 >上記の場合データがあった場合上書きされてしまうので上書きではなく
 >シート１の13 番目の値とシート2のフィルター後の13番目の値を合計して
 >シート２の13番目に求める方法を教えてください

 >こうしたらどうなりますか。
 >.Cells(v, MyCount).Value = .Cells(v, MyCount).Value + Worksheets("Sheet1").Cells(6, MyCount).Value

 現状の一行の改善では出来ないでしょうか？
 シート２は最下行まで数式を入れたら凄い容量になってしまいます。
 全てのアイテムを打ち込むと何万というアイテムになるので
 なるべくマクロで行いたいのです。

 プリン

コメント返信：

[ 一覧(最新更新順) ]

[[20050819081450]] 『データの転記なのですが…』（プリン） ページの最後に飛ぶ

[[20050819081450]]　『データの転記なのですが…』（プリン）　ページの最後に飛ぶ