[[20100123101125]]　『オートフィルタで検索データの貼り付け』（キョチャン）　ページの最後に飛ぶ

『オートフィルタで検索データの貼り付け』（キョチャン）
　最近マクロをはじめた新参者です。ＷｉｎｄｏｗｓＸＰ、Ｅｘｃｅｌ２００３のマクロでオートフィルタを使用し検索したデータを別シートに貼り付ける場合、検索データがない時、別シートの貼り付けセル以下のデータがすべて消えてしまいます。（罫線は残る。）解決方法のご教授を。

 基本的には、データが有ることを確認してから
 処理に移れば良いと思います。
[[20090919115924]]　『VBAのオートフィルターについて』（まー）

 (HANA)

次のようなユーザーフォームを使用してその中にテキストボックス及びコンボボックスを組み込み検索して手間を省いたマクロを組組んでいます。確認の手間を省きたいのですが。

 Selection.AutoFilter
    Selection.AutoFilter Field:=5, Criteria1:=検索開始日, Operator:=xlAnd, _
        Criteria2:=検索終了日
    Selection.AutoFilter Field:=13, Criteria1:=UserForm2.ComboBox1.Text
    Selection.AutoFilter Field:=10, Criteria1:="本型"
    上 = 6
        左 = 3
        下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row
        右 = 8
    Range(Cells(上, 左), Cells(下, 右)).Select
    Selection.Copy
    Sheets(UserForm2.ComboBox1.Text).Select
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 いくつかの項目で絞り込んで居るのですね。。。

 「下」に入った値がワークシートの最終行数を等しい場合
 データが無かったと考えてはどうでしょう？

 例えば
 '------
    上 = 6
    左 = 3
    下 = Cells(上, 左).End(xlDown).Row
    If 下 = Rows.Count Then
        MsgBox "抽出データなし。"
    Else
        MsgBox "抽出データあり。"
    End If
 '------
 こんな感じで。

 それと、回答とは関係ないのですが
 返信は、下のコメント欄から行って頂ければと思います。
 また、コメント記入の際はその都度ご署名をお願いします。

 (HANA)

ご指導有難うございます。ご教授マクロで試してみました。ＭｓｇＢｏｘが表示され、マクロはとまりますが、ＯＫを出すと、結果は同じです。検索数のスペースを確保し、その下段でも同様にして別の検索データを貼り付けるシートにしています。データ無しの場合、１～２行の空白を貼り付ける、またはこの作業を中止して次の作業に飛ぶことはできないでしょうか？よい案があればご教授願います。

（キョチャン）

 現在のマクロの意味を理解していますか？
 HANAさんのマクロでデータがあるか分かったわけですから、
 データがあったときだけ、続きの貼り付けを行えばいいです。（名無し１号）

　たぶん理解していないと思います。初心者です。データがあるとわかった時だけ、続きを貼り付ける方法を、ご教授ください。

　（キョチャン）

 「抽出データあり」
 のところに処理を書いてください。
 (Mook)

（ＨＡＮＡ）さん、（名無し1号）さん、（ＭＯＯＫ）さん有難うございました。おかげさまで思いどうり動くようになりました。ただ非常に長いマクロになりました。重複部分の削除、フロー制御等で短くすることは可能と思われますが、今後も勉強し対応してゆきたいと思います。（キョチャン））

 オートフィルタで検索したデータを他のシートにコピーした場合ＸＰでは検索どうりコピーできますがビスタでは検索した範囲のデータすべてがコピーされます。このため検索データを使用したマクロはビスタ上では誤作動してしまいます。解決方法を教えてください。（キョチャン）

    Range(Cells(上, 左), Cells(下, 右)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select

 こんな感じでいかがでしょう？
 （通りすがり）

　解決しました。（通りすがり）さん有難うございました。
教えてください。ユーザーフォーム内に作成したコンボボックスのリストはシート内に作成してその場所を指定して表示していますが、リストが少ない場合、マクロ内で処理しているサンプルがあったので、それを参考に、マクロをくんで見ましたが働きません。
　Private Sub UserForm_INITIALIZE()

ComboBox1.List = Array("A", "B", "C")

End Sub

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　（キョチャン）

 ０．パソコンを再起動する
 １．新しいブックを用意する
 ２．ユーザーフォームを挿入する
 ３．コンボボックスを一つ作成する
 ４．コードを貼り付ける
 ５．[ F5 ]キーでユーザーフォームを実行する

 ユーザーフォームが表示され
 コンボボックスは A,B,C が選択出来る様に成っていると思いますが
 なりませんか？

 (HANA)

 (ＨＡＮＡ）さんありがとうございました。問題は解決いたしました。本当はマクロの組み方のどこかに間違いがあるのだと思いますが、表示マクロが少ないので上記のような解決方法を出されたのでしょう。もっと勉強いたします。

　また新たな質問があります。重複防止で、次のようなマクロを組み実行していますが、重複のない時に続けてデータを作成しようとして、ＭｓｇＢｏｘのＹｅｓボタンをクリックしてもＭｓｇＢｏｘが消えません。またＮｏボタンをクリックすると、ＭｓｇＢｏｘが消えます。これをＹｅｓボタンでＭｓｇＢｏｘが消え、Ｎｏボタンでユーザーフォームを終了するように組めないでしょうか？

　If TextBox2.Text = "" Then Exit Do

        rend = ActiveSheet.UsedRange.Rows.Count
        Set 対象 = Range(Cells(5, 2), Cells(rend, 2))
        Set 検索 = 対象.Find(what:=TextBox2.Text)
        If 検索 Is Nothing Then
            Cells(rend + 1, 2) = TextBox2.Text
            確認 = MsgBox("続けて入力しますか?", 4)

        Else
            確認 = MsgBox("重複があります。", vbExclamation)
        Exit Sub
        End If
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　（キョチャン）

 コードは一部分だけではなく
 貼り付けて動かせる状態で載せてもらうのが良いと思います。

 また、今回の質問に関連する部分に関して
 　シートの何処にどの様なデータを用意しておけば良いのか
 　ユーザーフォームにはどの様な物をどう言った名前で設定しておけば良いのか
 こちらで実際に動かして見ようと思ったときに
 やって於かなくては行けな事（設定）を書いておかれるのが良いと思います。

 (HANA)

　（ＨＡＮＡ）さんご指摘のように元データの一部およびマクロを添付いたしました。
　下記のようなエクセルデータの最下行に新たなデータを追加するためにユーザーフォームを作成し追加しています。このユーザーフォームにコマンドボタンを２個つくりデータ追加と同時に注文書作成も行っています。下記のデータのうち図面番号が重複しないようにしています。このマクロを実行すると1つ前の相談の動きになります。対策をご教授ください。プレヴューでデータは横並びになっていますが最初の項目の下にデータが入っています。

(元データ）

 図番　　発注先　　　　納品先　　　品名　　　　．．．
 5600　　山田商店　　　トヨタ　　　GA-27A　　　．．．
 5601    鈴木ガラス　　日産　　　　EDガラス　　．．．
 5602　　広島金属　　　ホンダ　　　KBI-U573R   ．．．
（マクロ） 
Private Sub CommandButton1_Click()

    Dim insertrow As Long

    If TextBox2.Text = "" Then
    MsgBox "図番を入力してください。", vbExclamation, "入力エラー"
    Exit Sub
    End If

    Dim rend As Integer
    Dim 対象 As Range, 検索 As Range
    Dim 確認
    Do Until 確認 = vbNo
        If TextBox2.Text = "" Then Exit Do
        rend = ActiveSheet.UsedRange.Rows.Count
        Set 対象 = Range(Cells(5, 2), Cells(rend, 2))
        Set 検索 = 対象.Find(what:=TextBox2.Text)
        If 検索 Is Nothing Then
            Cells(rend + 1, 2) = TextBox2.Text
            確認 = MsgBox("続けて入力しますか?", 4)

        Else
            確認 = MsgBox("重複があります。", vbExclamation)
        Exit Sub
        End If
    Loop
 With Range("ﾃﾞｰﾀ一覧")

    insertrow = .Rows.Count
    .Rows(insertrow).Insert shift:=xlDown

    .Cells(insertrow, 1) = TextBox1.Text
    .Cells(insertrow, 2) = TextBox2.Text
　　.Cells(insertrow, 3) = ComboBox1.Text
    .Cells(insertrow, 4) = TextBox3.Text
    .Cells(insertrow, 5) = TextBox4.Text
    .Cells(insertrow, 6) = ComboBox2.Text
    .Cells(insertrow, 7) = ComboBox3.Text
    .Cells(insertrow, 8) = ComboBox4.Text
    .Cells(insertrow, 9) = TextBox5.Text
    .Cells(insertrow, 10) = TextBox6.Text
    .Cells(insertrow, 11) = TextBox7.Text
    .Cells(insertrow, 12) = TextBox8.Text
    .Cells(insertrow, 13) = TextBox9.Text
    .Cells(insertrow, 14) = TextBox10.Text
    .Cells(insertrow, 15) = TextBox11.Text
    .Cells(insertrow, 16) = ComboBox5.Text
    End With
End Sub　　　　　　　　　　　　　　　　　　　　　　　　　　　（キョチャン）

 こんな順番にしてみるとどうですか？

 '------
Private Sub CommandButton1_Click()
    Dim insertrow As Long
    Dim rend As Integer
    Dim 対象 As Range, 検索 As Range
'★１．図番入力の確認   →未入力なら、マクロ終了■
    If TextBox2.Text = "" Then
        MsgBox "図番を入力してください。", vbExclamation, "入力エラー"
        TextBox2.SetFocus
        Exit Sub
    End If
'★２．重複確認         →重複が有ったら、マクロ終了■
    rend = ActiveSheet.UsedRange.Rows.Count
    Set 対象 = Range(Cells(5, 2), Cells(rend, 2))
    Set 検索 = 対象.Find(what:=TextBox2.Text)
    If Not 検索 Is Nothing Then
        MsgBox "重複があります。", vbExclamation, "入力エラー"
        TextBox2.SetFocus
        Exit Sub
    End If
'★３．ユーザーフォームのデータをシートへ転記
    Cells(rend + 1, 2) = TextBox2.Text

     With Range("ﾃﾞｰﾀ一覧")
        insertrow = .Rows.Count
        .Rows(insertrow).Insert shift:=xlDown

        .Cells(insertrow, 1) = TextBox1.Text
        .Cells(insertrow, 2) = TextBox2.Text
        .Cells(insertrow, 3) = ComboBox1.Text
        .Cells(insertrow, 4) = TextBox3.Text
        .Cells(insertrow, 5) = TextBox4.Text
        .Cells(insertrow, 6) = ComboBox2.Text
        .Cells(insertrow, 7) = ComboBox3.Text
        .Cells(insertrow, 8) = ComboBox4.Text
        .Cells(insertrow, 9) = TextBox5.Text
        .Cells(insertrow, 10) = TextBox6.Text
        .Cells(insertrow, 11) = TextBox7.Text
        .Cells(insertrow, 12) = TextBox8.Text
        .Cells(insertrow, 13) = TextBox9.Text
        .Cells(insertrow, 14) = TextBox10.Text
        .Cells(insertrow, 15) = TextBox11.Text
        .Cells(insertrow, 16) = ComboBox5.Text
    End With
'★４．続けて入力するか確認 → Noの場合は、ユーザーフォームを閉じて
'                              マクロ終了■
    If MsgBox("続けて入力しますか?", vbYesNo) = vbNo Then
        Unload Me
        Exit Sub
    End If
'★５．ユーザーフォームのデータを消す
    TextBox1.Text = ""
    TextBox2.Text = ""
    ComboBox1.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    ComboBox2.Text = ""
    ComboBox3.Text = ""
    ComboBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
    TextBox7.Text = ""
    TextBox8.Text = ""
    TextBox9.Text = ""
    TextBox10.Text = ""
    TextBox11.Text = ""
    ComboBox5.Text = ""

    TextBox1.SetFocus
End Sub
 '------

 変数の宣言は一箇所にまとめて於いた方が良いと思いますので
 まとめました。

 (HANA)

 (HANA)さんありがとうございました。おかげで非常にすっきりした動きになりました。マクロの流れはおぼろげに理解できるようになりましたが、まだ技術的な、テクニックについては、まだまだ初心者です。そこで旗初歩的な質問をさせていただきます。
　　　
　　　Ａ　　　　　Ｂ　　　　　Ｃ　　　　　Ｄ
１　　図番　　　発注先　　　納品先　　　　品名　　　　・・・
２　５６００　　山田商店　　トヨタ　　ＧＡ－２７Ａ　　・・・
３　５６０１　　鈴木ガラス　日産　　　ＥＤガラス　　　・・・
４

　上記４行に別シートオートフィルタで検索したデータを貼り付けたいのですが、この空白行を取得するマクロのご教授を。Range("A4")ではつぎに同じ作業をした時またA4に貼り付けてしまいます。　　

 難しいですね。。。

 ＞　下 = Cells(上, 左).End(xlDown).Row
 このコードは、
 ＞　上 = 6
 ＞　左 = 3
 ですから、Cells(6, 3) = C6セル
   ＝ Range("C6").End(xlDown).Row
      ~~~~~~~~~~1 ~~~~~~~~~~2 ~~~3
 １．C6セルから
 ２．下方向へ連続する最後のセルの
 ３．行番号
 を取得します。

 End(xlDown) は、ワークシート上での Ctrl + ↓
 のキー操作と同じ様な物だと思っていただければ良いと思います。

 Ctrl + ↑ は、下ではなく上なので、End(xlUp) に成ります。

 「2行目は必ず入力が有る」なら
 Range("A1").End(xlDown) と言うコードで最後のセルが取得出来るので
 実際に貼り付けるセルはその一つ下のセルからです。
 .Offset(1) 等してもらえれば、一つ下のセルに成ります。

 A1～A3まで入力されている状態で、A1セルを選択し　Ctrl + ↓ をすると
 アクティブセルは無事にA3セルへ移動してくれます。

 しかし、A1セルしか入力がない状態で、同じ操作をすると
 アクティブセルはワークシートの一番下のセルまで移動して仕舞います。

 「2行目は必ず入力が有る」と言う前提が成り立ったとしても、
 不確かだと思うなら、やはり　ココでも
 最終行かどうかを確認して分岐してもらっても良いと思いますが
 　（最終行と一致したら、A2セルから貼り付け）

 Range("A" & Rows.Count) のセルから、End(xlUp) してもらって
 .Offset(1) のセルに貼り付けてもらう事にしても良いと思います。

 　こちらの処理の方が一般的に使われると思います。

 　何かの不手際で間に空セルを挟んで仕舞った場合、End(xlDown)では
 　最初に見つかった空セル以降のセルの上に貼り付いて仕舞うので
 　先に有ったデータが消えてしまいます。

 このスレの当初の御質問では
 オートフィルタで絞り込みが行われていたので
 少し挙動が変わってきます。
 注意してください。

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20100123101125]] 『オートフィルタで検索データの貼り付け』（キョチャン） ページの最後に飛ぶ

[[20100123101125]]　『オートフィルタで検索データの貼り付け』（キョチャン）　ページの最後に飛ぶ