【アプリ版】サポートOS変更のお知らせ

Office365のExcelVBAの質問です。

BookAでマクロを実行して、BookBを選択して開いた状態で、
BookBのシート「算出表」からBookAのシート「集計表」に値をコピーしたいです。

ただし、コピー元の範囲が分散していて
シート「算出表」のB5:E●の範囲(B5でCtrl+↓を押したのと同じ範囲)を
シート「集計表」のB220に値で貼り付け

シート「算出表」のEM5:〇〇の範囲(EM5でCtrl+→を押したのと同じ一番右の列までの範囲で最下行は●と同じ)を
シート「集計表」のF220に値で貼り付け

つまり「算出表」のF列~EL列が不要データなのです。
でも全体を貼り付けてから不要列を削除する方法は駄目です。
(集計表の関数式がおかしくなってしまう)

まだ範囲指定がよく分かっておらず、詳しい方ご教授いただければ幸いです。

質問者からの補足コメント

  • どう思う?

    ①自分で作ったソースの該当箇所を添付します。※文字数多いので分割します。
    ----------
    'ファイルを開く
    FName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", Title:="BookBを指定してください")

    '取込ファイルとシート名をセット
    Set srcBook = Workbooks.Open(FName)
    Set srcSheet = srcBook.Worksheets("算出表")

    <続く>

    No.1の回答に寄せられた補足コメントです。 補足日時:2021/07/28 11:36
  • どう思う?


    '必要レコードでフィルタしてコピー(範囲が500行以内の想定)
    srcSheet.Activate
    ActiveSheet.Range("$A$5:$FK$500").AutoFilter Field:=5, Criteria1:=Array( _
    "A", "B"), Operator:=xlFilterValues

    Range("B5", Cells(Range("B5").End(xlDown).Row, Columns.Count).End(xlToLeft)).Select
    Selection.Copy

    '貼付先(値)
    ThisWorkbook.Activate
    Range("B220").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    ----------
    <③に続く>

      補足日時:2021/07/28 11:36
  • どう思う?


    自分ではB列~FK列の範囲全てをコピーしてしまってますが、
    これを、B~E列とEM列~最右列の範囲だけ写せると無駄がないので質問した次第です。
    「ThisWorkbook.Activate」で自分のシートに戻ってきてるので、
    「集計表」というシートを明示せずにやってしまっています。

    悪い点など添削していただけると助かります。

    <以上です>

      補足日時:2021/07/28 11:37
gooドクター

A 回答 (5件)

こんにちは、


Range("B5", Cells(Range("B5").End(xlDown).Row, Columns.Count).End(xlToLeft)).Select
Selection.Copy
と書いているのですから、同様に範囲を分けてコピペすれば良いのでは、
と思います。
>まだ範囲指定がよく分かっておらず、詳しい方ご教授いただければ幸いです。
確かに範囲指定は判り難いですね。

(集計表の関数式がおかしくなってしまう) 少し心配ですが、
同じペースト先に出力するのであれば、最大出力範囲を想定して値を削除しないといけません。

範囲の指定方法は色々沢山あるので、、ごめんなさい うまくアドバイスできないのでサンプルです

Sub sample()
Dim srcBook As Workbook
Dim pstSheet As Worksheet, srcSheet As Worksheet
Dim Fname As String
Dim FilterRange As Range, Rng As Range
Const n As Integer = 4 'カラム拡張数 B列からE列で4

Set pstSheet = ThisWorkbook.Sheets("集計表")
'ファイルを開く
Fname = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", Title:="BookBを指定してください")
If Fname = "False" Then Exit Sub 'キャンセル対応

'取込ファイルとシート名をセット
Application.ScreenUpdating = False '開く前に画面制御
Set srcBook = Workbooks.Open(Fname)
Set srcSheet = srcBook.Worksheets("算出表")
'フィルタ範囲設定
Set FilterRange = srcSheet.Range("$A$5:$FK$500")

FilterRange.AutoFilter Field:=5, Criteria1:=Array( _
"A", "B"), Operator:=xlFilterValues

pstSheet.Range("B220").Resize(500, 29).ClearContents '想定最大範囲をクリア

With srcSheet
Set Rng = .Range("B5") 'コピー元範囲(起点のセル)
.Range(Rng, Rng.Offset(, n).End(xlDown)).Copy
pstSheet.Range("B220").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Set Rng = .Range("EM5") 'コピー元範囲(起点のセル)
.Range(Rng, .Cells(Rng.End(xlDown).Row, _
.Columns.Count).End(xlToLeft)).Copy
pstSheet.Range("F220").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With

FilterRange.AutoFilter 'フィルタ解除
' srcBook.Close SaveChanges:=False ’保存せずに閉じる
pstSheet.Activate
pstSheet.Range("B220").Select 'ペーストシート選択範囲後始末
Application.ScreenUpdating = True

End Sub

Withは書くのが面倒だったためです
    • good
    • 0
この回答へのお礼

ありがとうございます。Sampleちょっと修正しただけで意図通りです!
’保存せずに閉じる の行をコメントアウトしたら、ソースのブックが閉じますね。保存せずに閉じてしまうのですから、フィルタ解除は不要ですね。

ちょっと疑問は、
B220に書き込んだ結果は私のデータの場合5行のみ、それ以降の行は空欄で問題なしですが、
F220に書き込んだ結果は何故か、ずらっと下方向に0が書き込まれます。
私の場合は、下方向に203行、25列の範囲に"0"が入りました。
このままで特に問題はありませんが、原因と解消方法が分かると勉強になります。

お礼日時:2021/07/29 10:51

#4です


ごめんなさい、検証データを作成出来ないので検証が出来ません。
フィルタが正しく抽出できているか、コピー範囲は正しいかなどを
実行途中に Stop 命令を入れて検証してみてください。


FilterRange.AutoFilter Field:=5, Criteria1:=Array( _
"A", "B"), Operator:=xlFilterValues
Stop


Set Rng = .Range("EM5") 'コピー元範囲(起点のセル)
.Range(Rng, .Cells(Rng.End(xlDown).Row, _
.Columns.Count).End(xlToLeft)).Copy
Stop

Stop解除はF5キー、又はステップ実行F8キーで行えます。
    • good
    • 0
この回答へのお礼

ありがとうございます。F8とSTOPを挟みながら細かく見ていったら分かりました。
算出表のレコードが増えても良いように、関数を多めに下の方まで広げてまして(文章だと伝わらない気がしますが)、
レコード内部分が0になっていてそれを拾ってきてました。
レコードがない行は0でなく非表示になるようにして解決しました。

お礼日時:2021/07/29 18:16

No1です



>頂いたソースを自分のソースに組み込めません
・・というか、フィルターをかけているようですので、もしも、その結果の可視セル(行)をコピペしたいというのであるのなら、No1のコードではうまくいきません。
No1では、
>Range.Value = Range.Value
の形式で「値をコピー」していますので、不可視セル(行)も対象にしてしまいます。
(ご質問文に記載がないので、非表示行を想定していませんでした)

もしも、可視セル(行)のみコピーしたいのであれば、範囲指定はそのまま使うことは可能と思いますが、コピペ(Copyメソッド)でコピーするか、あるいは範囲内の可視行のみを順に「値をペースト」するような処理にする必要があります。
 Range.Copy
 Range.PasteSpecial Paste:=xlPasteValues
の形式で「値をペースト」する方法が簡単ではないかと思います。

ただしこの場合には、ペースト側に値が既に存在するような場合は、一旦クリアしておかないと、ペースト範囲外(行数以上の部分)には値が残ったままになりますのでご注意ください。
まぁ、クリアに関してはフィルターなしの場合でも同様ではありますが、フィルターをかけると対象行数は必ず減ることが想定されますので…
    • good
    • 0

マクロでなければだめですか?



マクロでなくても良いのであれば、多少の条件はありますが関数でも可能です。

 ='[BookB.xlsx]算出表'!B5:E10
とBookAの「集計表」シートのB220セルに入力すれば、「算出表」のB5からE10セルを表示できます。
(Excel 365 なので「スピル」を使えます)

この場合、E10セルを指定する方法を得られば問題は解決しますよね。

 =INDIRECT(" '[BookB.xlsx]算出表'!B5:E"&"10")
でも同じ結果を得られます。
この最後の ”10” を求めてみましょう。

「Ctrl+↓」
という事ですので、「連続したデータの最後のセルまで」という事でよろしいでしょうか。
ならば、最後のセルの下には何も入力が無いという前提で
 COUNTA関数
で、B列に入力されているセルの数を数えれば良いと思います。
 =COUNTA(B:B)-COUNTA(B1:B4)+4
こんな感じで ”10” を得られます。
 COUNTA(B:B)
でB列全体に入力されているセルの数。
そこから
 -COUNT(B1:B4)
で不明な4行目までに入力されているセルの数を引いて、
改めて
 +4
することで最終行の行番号を得られます。
 =INDIRECT(" '[BookB.xlsx]算出表'!B5:E"&"10")
  ↓
 =INDIRECT(" '[BookB.xlsx]算出表'!B5:E"& COUNTA(B:B)-COUNTA(B1:B4)+4 )
こんな感じ。

あとはEM列に対しても同様に数式を作るだけです。
    • good
    • 0
この回答へのお礼

読み込むファイルは特定のファイルではないため、マクロである必要があると思っています。

お礼日時:2021/07/28 11:43

こんにちは



以下未検証ですけれど、こんな感じではいかが?

Dim ss As Worksheet, rs As Range, n As Long
Set ss = Workbooks("BookB").Worksheets("算出表")

With ThisWorkbook.Worksheets("集計表")
 Set rs = ss.Range("B5")
 Set rs = Range(rs, rs.End(xlDown)).Resize(, 4)
 n = rs.Rows.Count
 .Range("B220").Resize(n, 4).Value = rs.Value

 Set rs = ss.Range("EM5")
 Set rs = Range(rs, rs.End(xlToRight)).Resize(n)
 .Range("F220").Resize(n, rs.Columns.Count).Value = rs.Value
End With
この回答への補足あり
    • good
    • 0
この回答へのお礼

大変ありがとうございます。
しかし力量不足で頂いたソースを自分のソースに組み込めません^^;
補足の方に、現在の自分のソースを開示させて頂きます。
ここに手を加えて何とかならないでしょうか?

お礼日時:2021/07/28 11:37

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

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