追記：指定値以外の行データを抽出・転記する為には

質問

画像と共に説明を追加致します。
E2、Y4以下には変換した日付シリアル値が入力されています。
また年月は変化し、データの内容、行数も変化します。
添付画像は転記先別シートになります。
転記先シートは元データのシートと同じブック内に作成されています。

◎Y列のE2の年月以外の行の
・Y列同行セルの年月データを別シートE7～14へ転記
・E列同行セル（上４桁を指定数値に変更）をB7～14へ抽出
・F列同行セル文字列をC7～14へ転記
・S列同行セル数値をF7～14へ転記
・T列同行セル数値をG7～14へ転記

◎Y列がE2の年月でC列が遅もしくは再という文字列の行の
・Y列同行セルの年月データを別シートE16～23
・E列同行セル（上４桁を指定数値に変更）をB16～23へ抽出
・F列同行セル文字列をC16～23へ転記
・S列同行セル数値をF16～23へ転記
・T列同行セル数値をG16～23へ転記

その後、転記先シートの空欄行をフィルターで畳み印刷

私が試行したことは、E列数値から14000000を引き指定数値(360とした場合3600000)を加えれば目的の数値になるのではと関数式を作成したこと、
Y列にフィルターを掛け、E2年月と等しくない日付を表示し、それをコピーして添付した場合、他の年月、データで行数が変わった場合、対応出来なくなるのではと、そこで詰まってしまったこと。
accessで行ったら出来るのではと調べ結果どっちつかずになってしまっていました。

説明もおぼつかない状況で煩雑な事を行おうとしており、最も相手にしたくない対象者であることは自覚しています。
にも関わらず、何度もお返事を下さり、本当に感謝致します。

不足してる情報や不明確な内容がありましたら、ご質問下さい。

宜しくお願い致します。

回答No.2

MarcoRossiItaly · ベストアンサー

前回のご質問（*）にて回答した者です。

*　http://okwave.jp/qa/q8725926.html

こちらからお尋ねしたことに関しては、残念ながら、ほとんどお答えを頂けていない状況のようです。新たに分かったことは、主な目的は転記だったということくらいです。

前回のご質問では、「質問者さん以外の方が同じファイルで作業されたい」とのことでした。私としては、前回の回答でも言ったとおり、セルへの数式のセットとオートフィルタ、場合によってはピボットテーブルなどを活用すれば、大抵のことは簡単に解決できるし、処理の種類からしてマクロが必要な感じはしないと思っています。しかし詳しい理由は分かりませんが、質問者さんとしては「どうしてもマクロで実現したい」とのご希望でした。質問者さんに情報の提供をお願いした理由は、主に、マクロ化のためです。そうしないと、ちんぷんかんぷんだからです。

こちらからお尋ねした項目を、次のとおり、再掲します。また、それぞれの問いに対する回答（質問者さんが提供される予定だった情報）を、こちらで勝手に想定しました。

(1) 具体的な値
　　● E2 セル・Y 列は、ある年月の月初の日のシリアル値（「2014/8/1」など）のみ
　　● B 列は、「'」を先頭に付加した文字列（「'平成26年5月」など）のみ
　　● C 列は、文字列「遅」、「再」または空白のいずれかのみ
　　● E 列のうち E2 以外は、8 桁の正の整数のみ
　　● F 列は、文字列のみ
　　● S 列・T 列は、数値のみ

(2) 項目名
　　現状では、項目名セルは存在しない。

(3) シートの構造
　　シート名は、「記録」。E2 セルと、B ~ Y 列の 4 行目以下のみにデータが存在。ただし、4 行目以下であっても空白になっているセルを含む列があり、具体的には C 列、D 列、G ~ R 列、T ~ X 列。また、B ~ Y 列の全てが空白になっている行が 4 行目以下で初めて出現すると、その行は最終行であり、それより下の行には一切データが存在しない。セルの結合はシート上に存在しない。

(4) どんな値になってほしいのか。
　　「指定数値」を「360」と定め、C 列が「遅」または「再」である行については、E 列の上 4 桁を指定数値で置換。

(5) 何列欲しいのか。
　　E、F、S、T、Y の 5 列

(6) 結果シートは新規に挿入するのか。
　　「集計」という名前のシートが既存。マクロを実行するたび、この同一シートを上書き。

(7) どのように Excel ファイルを使用するのか。
　　共有フォルダに保管し、不特定多数の人が同一ファイルを更新。

(8) 同じ元データに対して、様々な方法で抽出を繰り返すのか。
　　転記元の各行のデータを時間とともに更新。抽出の方法は変えないので、何度も同じマクロを実行。

(9) 前回の回答 No.1 の内容ではお役に立たないならば、どうなればよいのか。
　　●マクロを使ってさえいれば、それ以上の具体的な手法は、不問。
　　　様々な手法が考えられるが、どんなコードでも構わない。
　　●置換後、E2 セル、E、F、S、T、Y 列の値を別シートに転記。
　　● Y 列が E2 に等しくない行については、転記先のシートの 7 ~ 14 行目に転記。
　　　ただし該当する行数が 8 行を超える場合は、上から 8 行分のみを転記。
　　● Y 列が E2 に等しく、かつ C 列が「遅」または「再」である行については、転記先のシートの 16 ~ 23 行目に転記。
　　　ただし該当する行数が 8 行を超える場合は、上から 8 行分のみを転記。
　　●転記元の E、F、S、T、Y 列がそれぞれ転記先の B、C、F、G、E 列となるように転記。
　　　該当の行のうち、この 5 列以外は、転記しない。
　　●転記元 E2 の日付を転記先 B26 に転記。
　　●数式が記入されているセルについては全て、値のみ転記。

(10)年月やデータ内容、行数等が変わるのであれば、その範囲は何か。
　　●数値と文字列については、(1)の条件を満たす限り、どんな値にもなり得る。
　　●データの存在するセルの配置については、行数以外は変化しない。

(11)質問者さんが質問前に行ってきたという「試行錯誤」の具体的な内容
　　14000000 - 3600000 という計算のみ

＞添付画像は転記先別シートになります。

順序が逆です。元データの内容を把握するほうが先です。

今回の質問文の画像は見ず、前回の画像から想像をふくらまして、今回も回答を書いています。今回の質問文は、コピー元とコピー先のセルのアドレスが混在した文章になっているようですね。新しく参入される回答者さんにとっては、ますます難解かと思います。

本来であれば、ご質問の内容は、「全く難しくありません」。そうではなくて、質問の仕方が、はっきり言って良くないということを自覚してください。

＞accessで行ったら出来るのではと調べ結果どっちつかずになってしまっていました。

この程度の処理が Excel でできないとしたら、Access でも同じことだと考えられます。

お手元の実際の Excel ファイルと比べて上の想定が異なっているという場合は、そちらで適切にコードを修正してください。マクロを作製する以上、必要な知識をご自分で習得しながら、メンテも行っていってください。

更なるご質問がある場合は、「それがまさに質問である場合は」対応します。しかし単に、質問者さんが行われるファイル作製作業の完成を手伝うためだけのコード修正であれば、こちらでの対応は遠慮します。ボランティア活動ですので、完全な決着を見られなかったのは残念ですが、これ以上の時間と労力を費やすことはできません。また、ここは本来、質問を行うところであって、業務委託の場ではありません。そういう意味でも、これ以上は遠慮します。

なお字数の関係で、コードは回答 No.3 に掲載します。

お礼

お時間をさいて再度お返事頂き有難う御座います。
試行錯誤は私の出来る限りのことをもっと多く試してみたのですが、筆談で文章に出来るのが限られてしまいました。
的確に質問することも出来ない知識レベルの為、過度な負担をおかけしてしまい申し訳ありません。
でも責任感の強い方のようで時間を割いてアドバイスを下さり、嬉しく思っております。
教えて頂いたコードを参考に再度調べて完成を目指したいと思います。
本当に本当に有難う御座いました。

回答No.3

MarcoRossiItaly

No.2 の続きです。字数の関係で、コードはこちらに載せます。実行すると、添付図のような感じになります。

Sub ExtractMonthlyData()

　　Dim LastRow As Long, RepNumber As Long, Cell As Range, i As Long, j As Long, n As Long
　　RepNumber = 360　　'指定数値（整数）

　　With Worksheets("記録")
　　　　LastRow = .Cells(Rows.Count, "y").End(xlUp).Row
　　　　.Copy before:=Worksheets(1)
　　End With

　　With Worksheets(1)
　　　　With .Range("b2:y" & LastRow)
　　　　　　On Error Resume Next
　　　　　　.Value = .Value
　　　　　　On Error GoTo 0
　　　　End With
　　　　For Each Cell In .Range("e4:e" & LastRow)
　　　　　　Cell.Value = RepNumber & Right(Cell.Value, 4)
　　　　Next Cell

　　　　.Range("b3:y" & LastRow).AutoFilter field:=24, Criteria1:="<" & .Range("e2").Value
　　　　j = 4
　　　　For i = 4 To LastRow
　　　　　　If n = 8 Then Exit For
　　　　　　If .Rows(i).Hidden = False Then
　　　　　　　　n = n + 1
　　　　　　　　j = i
　　　　　　End If
　　　　Next i
　　　　On Error Resume Next
　　　　.Range("e4:f" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("b7")
　　　　.Range("s4:t" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("f7")
　　　　.Range("y4:y" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("e7")
　　　　On Error GoTo 0
　　　　j = 4
　　　　.Range("b3:y" & LastRow).AutoFilter field:=24, Criteria1:=Format(.Range("e2").Value, "ggge""年""m""月""")
　　　　.Range("b3:y" & LastRow).AutoFilter field:=2, Criteria1:="遅", Operator:=xlOr, Criteria2:="再"
　　　　For i = 4 To LastRow
　　　　　　If n = 8 Then Exit For
　　　　　　If .Rows(i).Hidden = False Then
　　　　　　　　n = n + 1
　　　　　　　　j = i
　　　　　　End If
　　　　Next i
　　　　On Error Resume Next
　　　　.Range("e4:f" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("b16")
　　　　.Range("s4:t" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("f16")
　　　　.Range("y4:y" & j).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("集計").Range("e16")
　　　　On Error GoTo 0

　　　　.Range("e2").Copy Destination:=Worksheets("集計").Range("b26")
　　End With

　　Worksheets("集計").Range("b7:g23").Borders.LineStyle = xlContinuous
　　Application.DisplayAlerts = False
　　Worksheets(1).Delete
　　Application.DisplayAlerts = True
　　Worksheets("集計").Select

End Sub

回答No.1

MackyNo1

いろいろ説明されているようですが、提示された質問内容では、質問のポイントが縛られていないため、何がしたいのかよくわかりません。

このような質問では、抽出先のシートのレイアウトはあまり重要ではなく、元データがどのようなデータで、どのような条件で抽出するのかだけが問題となります。

また前回の質問の続きなら、回答者にこれまでの経過がわかるように前回の質問のリンクを付けるようにしましょう。

＞◎Y列のE2の年月以外の行の
・Y列同行セルの年月データを別シートE7～14へ転記
・E列同行セル（上４桁を指定数値に変更）をB7～14へ抽出
・F列同行セル文字列をC7～14へ転記
・S列同行セル数値をF7～14へ転記
・T列同行セル数値をG7～14へ転記

上記の質問も、いくつか質問項目がありますが、実際はY4セル以下に入力されているデータから、E2セルの値と異なる行だけを抽出したいという質問だけで、その数式あるいはマクロを応用すれば、ほかの列の質問も解決できるのではないでしょうか？

たとえばF列の文字列を抽出するなら以下の式を入力して下方向にオートフィルします。

=INDEX(F:F,SMALL(INDEX(($Y$4:$Y$1000=$E$2)*10000+ROW($4:$1000),),ROW(1:1)))&""

S列の数値やシリアル値を抽出するなら以下のような数式になります。

=IF(上記のセル番地="","",INDEX(S:S,SMALL(INDEX(($Y$4:$Y$1000=$E$2)*10000+ROW($4:$1000),),ROW(1:1))))

ちなみに「E列同行セル（上４桁を指定数値に変更）」の意味が分かりませんが、この部分はご自分で対応できるのではないでしょうか？

＞◎Y列がE2の年月でC列が遅もしくは再という文字列の行の
・F列同行セル文字列をC16～23へ転記

このケースなら上記の式を以下のように修正します。

=INDEX(F:F,SMALL(INDEX((($Y$4:$Y$1000<>$E$2)+(($C$4:$C$1000<>"遅")*($C$4:$C$1000<>"再")))*10000+ROW($4:$1000),),ROW(1:1)))&""

同様に他の列のセルも上記で説明した数値やシリアル値の場合の数式で対応できます。

＞その後、転記先シートの空欄行をフィルターで畳み印刷

目的が不明です。
最初から空白を除いたセルだけ抽出すればよいのではないでしょうか？

＞私が試行したことは、E列数値から14000000を引き指定数値(360とした場合3600000)を加えれば目的の数値になるのではと関数式を作成したこと

何の計算をしているのか意味不明です。

おそらく、本当はもっと簡単な操作や関数で目的の表示ができるような気がしますが、ひとまず与えられた情報だけからの関数を使った回答例です。

補足

前回の質問のリンクは、
http://okwave.jp/qa/q8723573.html
となります。
前質問にお答えくださった方より頂いた情報の不足箇所を付け加えた追記質問です。
リンクを貼ればまた色々な方がご回答下さる機会が得られますよね。
無知が過ぎるので、情報追記でも不足があるかと思います。
関数式、参考に致します。
宜しくお願い致します。