VBA 可視セルのみをoffsetで移動

質問

VBA 可視セルのみをoffsetで移動したいです。

AutoFilterで表示した"A列の"可視セルのみを、1セルずつoffsetで下方向に移動したいです。
　ＡＢ
１○○
２○✕
３✕○
４○✕
５
・
・
・
これにフィルタをかけ、　○　のみを表示すると
　▼
　ＡＢ
１○○
２○✕
４○✕
５
・
・
・
になりますが、
range("A1").offset（1,0）.select
で1セルずつ順に下へ降りていくと 非表示のA3も選択されてしまいます。

どうすればよいでしょうか？

回答No.4

SI299792 · ベストアンサー

私の所では正しく動いているので、動かない理由は解りません。
画像をつけ忘れたので、私の思っているものと実ワークブックが、違う可能性があります。

関数でもいいなら、
A2: =IFERROR(INDEX(Sheet1!A:A,MATCH(ROW()-1,$D:$D,0)),"")
B2: =IFERROR(VLOOKUP(A2,Sheet1!A:D,4,0),"")
C2: =LOOKUP(1,0/(Sheet1!A$2:A$99=A2),Sheet1!D$2:D$99)&""
D2: =D1+(COUNTIF(Sheet1!A$2:A2,Sheet1!A2)=1)
纏めて下へコピペ。
（Ｄ列はワークエリアです。Sheet1と同件数以下まで必要です。目障りなら非表示にして下さい。）

お礼

画像までつけていただき、ありがとうございました。
関数によるアプローチは考えていなかったので、大変勉強になりました。
今回、親身に相談にのり、ご丁寧に回答をくださったお二人に感謝申し上げます。
ありがとうございました。

回答No.3

imogasi

捕捉を頂き有難う。
ーー
それに基づいてやって見た。
当初（前回、今回）の質問文から、今回のようなニーズややったこと、やりたいことは想像できない。
質問文と条件と結果のデータ例を例示して質問するもんだ。
ーーー
作業①の箇所
データ例
Sheet1　A1:E8
- 得点者　アシスト者　チーム名　得点時間　　　　
1 スズキ　　山田　　　A大学　　前半10分
2 山田　　　スズキ　　A大学　　前半20分
3 スズキ　　及川　　　A大学　　前半31分
4 吉岡　　　沼野　　　B大学　　前半35分　
5 スズキ　　田中　　　A大学　　後半11分
6 大迫　　　中村　　　C大学　　後半22分
7 大迫　　　ロン　　　C大学　　後半40分
ーー
VBAでもできるが、操作でできるのでフィルター詳細設定で行った。
条件　G1:G2
得点者
スズキ
このフィルタ―の条件の部分は、質問に書いてない。当方推定。
大切な部分なので必ず書くこと。
ーー
抽出結果　K1:N8を指定
結果
得点者 アシスト者 チーム名 得点時間
スズキ 山田 A大学 前半10分
スズキ 及川 A大学 前半31分
スズキ 田中 A大学 後半11分
ーー
Sheet2の質問のデータ例では、上記の
及川
田中
の例が漏れている。
データ例としておかしい。
ーー
②の作業は、質問者は、VBAでやるらしい（Findで）、今回は簡単のため、VBA略。手作業で行う。
countifを使うなら、VBAのFind（メソッド）は使う必要ないだろう。
countifでは判別はできても、存在する場所（セル範囲の行は）判らないのでは。
ーー
当方で追加する。
③の作業。
及川 前半15分 後半25分
田中 前半11分 後半16分
ーー
Sheet2
選手名　最初　　　最後
スズキ　前半10分　後半11分
山田　　前半20分　前半20分
吉岡　　前半35分　前半35分
大迫　　後半22分　後半40分
及川 　前半15分　後半25分
田中 　前半11分　後半16分
ーー
データが２シートに別れてしまっている。
「選手名」は、Sheet1の「得点者」か。（アシスト者か？）。
質問としては、サッカー門外漢には、不親切。
データベース的には、ファイルの「結合」でやるところだが、質問者には、そういう意識はないらしい。
シコシコ繰り返し法でやると
Sub test01()
lr = Worksheets("Sheet1").Range("K100000").End(xlUp).Row
lr2 = Worksheets("Sheet2").Range("A100000").End(xlUp).Row
For i = 2 To lr
For j = 2 To lr2
If Worksheets("Sheet1").Cells(i, "K") = Worksheets("Sheet2").Cells(j, "A") Then
Worksheets("Sheet1").Cells(i, "O") = Worksheets("Sheet2").Cells(j, "B")
Worksheets("Sheet1").Cells(i, "P") = Worksheets("Sheet2").Cells(j, "c")
End If
Next j
Next i
End Sub
ーー
結果
Sheet1　K列ーP列
得点者 アシスト者 チーム名 得点時間 最初 最後
スズキ 山田 A大学 前半10分 前半10分 後半11分
スズキ 及川 A大学 前半31分 前半10分 後半11分
スズキ 田中 A大学 後半11分 前半10分 後半11分
＝＝＝
④　　の作業で、「最初と最後」 を見つけるとして、最初と最後とは？
対象は１つしかないのかな。
上記の 「スズキ」の例では、「前半10分 後半11分」が結論か？
＝＝
以上で、何処でOffsetを使わなければならないのか、判らない。
例の該当ががスズキ１人しかない例なので 判らないのかな。
＝＝
捕捉でも、質問の意味がよく判らないので、小生は取り敢えず、回答から、身を引く。

お礼

分かりづらい例と質問内容で申し訳ない。
次からは回答者の視点で詳細に記入致します。
丁寧に回答いただきどうもありがとうございました。

回答No.2

SI299792

imogasi さんの補足を拝見しましたが、どう見てもオートフィルターは関係ないと思うのですが。
Sheet1→Sheet2の様にしたいなら、フィルターをかけずに実行して下さい。
Option Explicit
'
Sub Macro1()
　　Dim I As Worksheet
　　Dim RInp As Long
　　Dim ROut As Long
　　Dim What As String
'
　　Set I = Sheets("Sheet1")
　　Sheets("Sheet2").Select
　　Range("A2:C" & Rows.Count).ClearContents
　　RInp = I.Cells(Rows.Count, "A").End(xlUp).Row
　　I.Range("A2:A" & RInp).Copy [A2]
　　I.Range("D2:D" & RInp).Copy [B2]
　　Range("A2:B" & RInp).RemoveDuplicates 1
　　ROut = Cells(Rows.Count, "A").End(xlUp).Row
　　Range("C2:C" & ROut) = _
　　　　"=LOOKUP(1,0/(Sheet1!A$2:A$" & RInp & "=A2),Sheet1!D$2:D$" & RInp & ")"
　　Range("C2:C" & RInp) = Range("C2:C" & RInp).Value
End Sub

①１行づつフィルターをかけて実行したいのですか。効率が悪いですが、どうしてもそうしたいなら書いて下さい。
②やろうと思えば関数でも可能です。必要ならバージョンを書いて下さい。

お礼

回答ありがとうございます。
>①１行づつフィルターをかけて実行したいのですか。効率が悪いですが、どうしてもそうしたいなら書いて下さい。
→希望の操作が実現出来るならフィルターをかけずとも問題ありません。補足に書きました例を用いますと、フィルターをかけることで、"sheet1　フィルター後"　において得点者の最後の時間をEnd(xlUp)で取得出来そうと思ったので使用しました。

>②やろうと思えば関数でも可能です。必要ならバージョンを書いて下さい。
→Microsoft Excel 2019 MSO
Excel　バージョン1903　です。

また、回答いただいたコードを実行してみました。
・sheet2に対する動作が、シートのセレクトのみ。
・sheet1のD2の値が、B3とC2に貼り付けされる
。
という結果になりました。
希望の動作は
・sheet1の得点者の名前が、sheet2に無ければ転記
・得点者の最初と最後の得点時間をsheet1からsheet2へ転記
・同様の操作を各得点者で繰り返す
最終的には、sheet2に得点者の全員の名前と、その最初と最後のゴール時間の表を作成できればよいです。そのための手段は関数でもVBAでも構いません。

回答No.1

imogasi

昨日の質問に対する回答では、うまく行ったような、お礼の書き振りなのだが、どう、うまく行かないのか？
実際にWEBの記事で学び、それで教えてもらって、（今回は自分でコードを作り、実行して、お礼を書くべきだと思う。
昨日の質問に対しては、小生は、すぐ
Sub test01()
Sheets("Sheet1").Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
End Sub
のようなので済むと思った。（締め切り済み直後ぐらいで、回答できなかったが）
データ
Sheet1のA1:C6
コード 名前　 計数
a ｘ 12
b ｙ 23
c ｚ 21
a ｙ 6
a う 8
フィルタ結果　手動でテキストフィルタで、コードの列で「a」を条件にした。
結果（見た目）
Sheet1では、
上記コードの実行結果Sheet２と同じです。
コード 名前 計数
a ｘ 12
a ｙ 6
a う 8
＝＝＝＝＝
これをセル番地も含めてどうなってほしいのか、説明すること。
出来れば、セル番地とセルの値の対応を示して説明してほしい。
ーー
Offsetをなぜ使うのか、前質問から理由が判らなかった。
勝手に、初心者の思い付きなのだろう、と思った。
ーー
今回も全く同じ質問文で、説明しようとする工夫が見られない。それで意図が判らない。
返答をほしい。

お礼

どうもありがとうございました。
精進します！

補足

回答ありがとうございます。
　以前の質問では、頂いた回答を試す前に質問を締め切りました。実際に試した結果、想定した動作を実現出来なかったため再度質問させていただきました。
　ご指摘の通りで、WEB記事で学習し、自分で実行した後に回答を締め切りたいと考えています。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

sheet1"サッカーダイジェスト用“
Ａ　　　　Ｂ　　　　Ｃ　　　　　Ｄ
1 得点者　アシスト者　チーム名　得点時間　　　　
2 スズキ　　山田　　　A大学　　前半10分
3 山田　　　スズキ　　A大学　　前半20分
4 スズキ　　及川　　　A大学　　前半31分
5 吉岡　　　沼野　　　B大学　　前半35分　
6 スズキ　　田中　　　A大学　　後半11分
7 大迫　　　中村　　　C大学　　後半22分
8 大迫　　　ロン　　　C大学　　後半40分
以下同じ形式で複数行あり

sheet1　フィルター後
得点者　アシスト者　チーム名　得点時間
スズキ　山田　　　　A大学　　前半10分
スズキ　及川　　　　A大学　　前半31分
スズキ　田中　　　　A大学　　後半11分

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

sheet2"選手毎の最初と最後の得点時間"
選手名　最初　　　最後
スズキ　前半10分　後半11分
山田　　前半20分　前半20分
吉岡　　前半35分　前半35分
大迫　　後半22分　後半40分

例はスズキ。他選手もFor Next で同様の処理

手順①
sheet1のA列”得点者”をオートフィルタにかける
手順②
フィルタをかけた名前が、sheet2のA列”選手名”に記載があるか確認
→findで確認
手順③
もし未記載であれば名前を転記
→CountIf=0なら転記
手順④
転記された得点者の得点時間の、最初と最後の時間を抽出
→最後の時間はCells(Rows.Count, 4).End(xlUp)で取得
→最初の時間はCells(1,1).offset(1,0)で取得

手順④の"最初の時間"の取得をoffsetを使用し実現したいと考えた故の質問でした。
CurrentRegionでは、可視セル全てを選択してしまうため、上手くいきませんでした。

offsetは不可視セルも選択してしまうため、どうにか可視セルだけを移動(キーボードの↓ボタンを押した動作)したいと思っています。