エクセルＶＢＡ一つ上の行を指定した回数分コピーする。

Question

https://oshiete.goo.ne.jp/qa/9671375.html
前回の引き続きです。
よろしくお願いします。

ボタンマクロの名前です。
xlsb'!ボタン2_Click　でした。

前回は質問の補足が不足してしまい焦ってしまって、一気に沢山質問してしまい…
混乱してしまいました。１個づつ落ち着いて取り組んでいこうと思います。
よろしくお願いします。
増え続けていくデータの領域指定について、ご教授お願いします。
名前の定義の範囲指定について
シート名は　管理表　です。
ＡからZ列まであって、
行については増え続けていきます。増えていく行を確認するのは、Ａ列です。
項目名の記載のあるのは、A6です。
データを入力するのは、Ａ７から取りあえず、Z７までにしたいです。
データはこれから増え続ける予定です。

補足として、画像を別添しました。

yokomaya · Accepted Answer

まずさあ、
sub ほにゃらか()　　　　　　’ほにゃらかはあなたがつけたいSub名を自由に
              ここに記述しないと！！
End sub

どうやって今まで試してたの？

で
Worksheets("Sheet1”）に変えてもいいって書きましたよね。
Worksheets("管理表”).   て、なってないんじゃない？

それとあくまでもそれは入れ物で中身はまだ書いてないからね。
絞り込んでるかいないかをそうやって判断できるから
それぞれの場合でかき分けたらいいかなというもの。

yokomaya · Answer

名前の定義ですが前回のスレッドでは
＝OFFSET(管理表!A7,0,0,COUNTA(A:A)-1,18)
としていましたよね。
18が横の数なので26に変えたらＺ列までになります。
A列の文字を数えているのでA6の項目の分1引いているのが
この式になります。
ひとつ心配なのはボタンに隠れるA1:A5に
なにか誤って文字が入るとずれることですが
ま、それは注意すれば大丈夫でしょう。
大事な事忘れてました。絶対指定が抜けてましたね。
これじゃ入力するセルによって範囲がずれてしまいます。

ですから式はこんな感じかな。
＝OFFSET(管理表!$A$7,0,0,COUNTA($A:$A)-1,26)

ただ僕の場合こういった表は$A$6始まりにします。
項目名とかも拾えるから。
ま、そこは好みですが。

tom04 · Answer

こんばんは！

横からお邪魔します。
質問内容を拝見するとわざわざ「コマンドボタン？」を使わなくてもChangeイベントで良いのでは？

あくまで一例です。
まず↓のコードを標準モジュールにしてください。

Sub Sample1()   'この行から//
    Dim lastRow1 As Long, lastRow2 As Long, lastCol As Long, wS As Worksheet
    Set wS = Worksheets("Sheet2")   '//「Sheet2」は実際のシート名に！//
    With Worksheets("Sheet1")   '//「Sheet1」も実際のシート名に！//
        lastRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(6, Columns.Count).End(xlToLeft).Column
        lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
        If lastRow2 > 5 Then
            Range(wS.Cells(6, "A"), wS.Cells(lastRow2, lastCol)).Clear
        End If
            .Range("A6").AutoFilter field:=1, Criteria1:=.Range("A1")
                If .Cells(Rows.Count, "A").End(xlUp).Row > 6 Then
                    Range(.Cells(6, "A"), .Cells(lastRow1, lastCol)).SpecialCells(xlCellTypeVisible).Copy wS.Range("A6")
                    .AutoFilterMode = False
                Else
                    .AutoFilterMode = False
                    MsgBox "該当データなし"
                End If
    End With
End Sub 'この行まで//

次に↓のコードを元データ（Sheet1）のシートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target <> "" And Target.Address = "$A$1" Then
            Call Sample1
    End If
End Sub

これでSheet1のA1セルが変更のたびに
Sheet2のA6以降にデータが表示されると思います。m(_ _)m

tom04 · Answer

No.3です。

＞sheet1の名前が　管理表　です。
＞検索結果を表示したいのも、sheet1のA1のセルだった場合はどうしたらよいのでしょうか？

まず、Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト

Sub Sample1()   'この行から//
    Dim lastRow As Long, lastCol As Long, wS As Worksheet
    Set wS = Worksheets("Sheet2")   '//「Sheet2」は実際のシート名に！//
    With Worksheets("管理表")   '//←シート名を変更★//
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(6, Columns.Count).End(xlToLeft).Column
            wS.Cells.Clear
            .Range("A6").AutoFilter field:=1, Criteria1:=.Range("A1")
                If .Cells(Rows.Count, "A").End(xlUp).Row > 6 Then
                    Range(.Cells(6, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
                    .AutoFilterMode = False
                Else
                    .AutoFilterMode = False
                    MsgBox "該当データなし"
                End If
    End With
End Sub 'この行まで//

次に表示されているVBE画面の左側に「Sheet1（管理表）」と表示されていると思いますので
そこをダブルクリック　→　表示されたVBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target <> "" And Target.Address = "$A$1" Then
            Call Sample1
    End If
End Sub

Excel画面を閉じて「管理表」シートのA1セルに検索データを入力してみてください。m(_ _)m

tom04 · Answer

No.3・4です。

投稿後もう一度読み返してみると・・・

＞検索結果を表示したいのも、sheet1のA1のセルだった場合はどうしたらよいのでしょうか？

すなわち元データは「管理表」シートにあり、「Sheet1」に表示したい！というコトですね？

No.4の標準モジュール、コード内の
＞Set wS = Worksheets("Sheet2")
を
＞Set wS = Worksheets("Sheet1")
に変更してください。m(_ _)m

tom04 · Answer

続けてお邪魔します。

＞ここの部分が良く割りませんでした。
＞次に表示されているVBE画面の左側に「Sheet1（管理表）」と表示されていると思いますので

それでは別の方法で・・・
一旦VBE画面を閉じてください。
画面左下にあるシート名「管理表」のシート見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト

Private Sub Worksheet_Change(ByVal Target As Range)
If Target <> "" And Target.Address = "$A$1" Then
Call Sample1
End If
End Sub

これで上記コードが「管理表」シートのシートモジュールになりましたので
「管理表」シートのA1セルに色々データを入れてみてください。m(_ _)m

tom04 · Answer

ん～～～

＞私の貼り付けがまずかったのでしょうか？

貼り付け方云々というよりシート名が全く違っていますよね。
画像が小さくて確認できないのですが、
貼り付け先Sheetのシート名は「Sheet1」や「Sheet2」ではなく、「貼り付け？」（？の部分がよく判りません)
というシート名になっていますね。

コード内の「Sheet2」の部分をそのシート名にする必要があります。

※　今まで説明してきたことは基本的なコトです。
当然のコトですが最初からできる人はいませんが、ある程度基本的なコトが理解できていないと
他人のコードをコピー＆ペーストするだけでは、不具合があってもご自身で手直しができません。
当方がココで投稿しているコードがベストとは言えませんので、
最初は無駄なコードがあっても良いと思うので、
まずはご自身でコードを書いてみるコトだと思います。

そうした上ででこちらのようなサイトを利用すれば他の方々からも
色々アドバイスがいただけると思います。m(_ _)m

tom04 · Answer

それでは最後にコードにコメントを記載しておきます。

まず↓の画像の左側「管理表」シートのシートモジュールに↓のコードをコピー＆ペースト

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target <> "" And Target.Address = "$A$1" Then
            Call Sample1
    End If
End Sub

次に標準モジュールに↓のコードをコピー＆ペースト

Sub Sample1()   'この行から//
    Dim lastRow As Long, lastCol As Long, wS As Worksheet
    '//「貼り付け用」シートを「wS」という変数に格納//
    Set wS = Worksheets("貼り付け用")
    '//「管理表」シートの・・・//
    With Worksheets("管理表")
        '//最終行を取得//
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        '//6行目で最終列を取得//
        lastCol = .Cells(6, Columns.Count).End(xlToLeft).Column
            '//「貼り付け用」シートのデータを一旦消去//
            wS.Cells.Clear
            '//「管理表」シートのA列をA1セルのデータをキーとしてフィルタを掛ける//
            .Range("A6").AutoFilter field:=1, Criteria1:=.Range("A1")
                '//A1セルのデータがあれば表示されているデータを「貼り付け用」シートのA1に貼り付け//
                '//（データがない場合は項目行だけの表示になるので「>6」としている）//
                If .Cells(Rows.Count, "A").End(xlUp).Row > 6 Then
                    Range(.Cells(6, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
                    '//オートフィルタを解除//
                    .AutoFilterMode = False
                Else
                    '//A1セルのデータがない場合、メッセージボックスを表示//
                    .AutoFilterMode = False
                    MsgBox "該当データなし"
                End If
    End With
End Sub 'この行まで//

これで「管理表」シートのA1セルにデータを入力してみてください。

※　こちらで上記のコードでは↓の画像のような感じになります。m(_ _)m

yokomaya · Answer

ちょっと整理しておきますね。

それと僕の話とtomo04さんの話は一緒くたにすると意味不明になるから
ブックは別名でお願いします。

＞前回のスレッドの質問で、オートフィルターの検索マクロを

この話しの流れは表示的には管理表でオートフィルターをかけるのと
ほぼ同じデータだと。
ただ表示するのは別のシートのK17:L18で指定したもので
管理表をフィルタリングしたデータを、その別シートに
という話でしたよね。

だからオートフィルターで絞り込んだのを、もう一つのシートに
貼り付ける想定で話しかけてました。
補足の②がその時のことです。
オートフィルターで操作するときに事前に絞り込み状態を知って
処理するのが妥当と考えたのです。

その流れの中で、フィルターの詳細設定に、ちょっと横道それましたが
（というか、そっちが本筋で良かったんじゃないかと思うけど、）
補足②でオートフィルターに戻す話を言われたので・・・
動かすこと自体はどっちでも出来ますよ。

ただ、No1に書いた通りですが、管理表のA1:A5は名前定義に
あたって使わない前提ですから、お忘れなく。

yokomaya · Answer

この質問最初の画面が変だなぁ。
どうしてこうなったのかな？

僕は前のスレッドの最後の補足の画面で処理することを
考えてました。K17:L18に入力したので絞るから
そのシートのコマンドボタンで起動。
勿論オートフィルターは管理表シートですが、
そこは手で操作するわけじゃないと。
表示するのも入力した画面だしね。

それがフィルターの詳細設定なら、管理表シートはデータ置き場
というだけで、名前定義さえ済んでたら、その名前しか使わない
考えでした。

エクセルＶＢＡ 一つ上の行を指定した回数分コピーする。

名前の定義ですが前回のスレッドでは

まずさあ、

こんばんは！

No.3です。

No.3・4です。

続けてお邪魔します。

ん～～～

それでは最後にコードにコメントを記載しておきます。

ちょっと整理しておきますね。

この質問最初の画面が変だなぁ。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセルＶＢＡ一つ上の行を指定した回数分コピーする。