[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAのマクロがうまく動かない』(ノブ)
VBAで同じフォームの複数シートを一つのシート(集約シート)にまとめるマクロを組んだのですが一つのシート(最後のシート)しかコピーされません。原因は何でしょうか?
集計したい表のタイトル位置は(C12:H12)、集計したい内容は(C13)から各シートの内容をコピーして繋げていきたいです。
大変困っており教えて頂ければ幸いです。
マクロは以下の内容です。
Sub ?B完成()
Dim sWS As Worksheet 'データシート(コピー元) Dim dWS As Worksheet '本部提案シート(コピー先)
Set dWS = Worksheets("本部提案シート")
'本部提案シートの13行目以降を削除 dWS.UsedRange.Offset(12, 0).Clear
'各シートの13行目以降のデータを、集約用シートの末尾にコピー For Each sWS In Worksheets If sWS.Name <> dWS.Name Then With sWS.UsedRange
'コピー元シートにデータが1件以上ある場合 If .Rows.Count > 1 Then .Offset(12, 0).Resize(.Rows.Count - 1).Copy _ Destination:=dWS.Cells(Rows.Count, 1). _ End(xlUp).Offset(12, 1) End If
End With End If Next sWS
どうぞよろしくお願い致します。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
'コピー元シートにデータが1件以上ある場合 .Offset(12, 0).Resize(.Rows.Count - 1).Select Selection.Copy dWS.Cells(Rows.Count, 1).End(xlUp).Offset(12, 1).Select Selection.Paste
これでステップ実行してみて、どこを選択しているか確認してみてください
(ひでお) 2020/04/15(水) 12:21
上記修正のうえ実行してみたところ、
.Offset(12, 0).Resize(.Rows.Count - 1).Select
の部分がエラーで網掛けされておりました。
「'コピー元シートにデータが1件以上ある場合」の下から削除していただいたマクロ文を入れ替えました。 貼り付けに問題があったのでしょうか? よろしくお願い致します。 (ノブ) 2020/04/15(水) 12:41
sWS.Activate .Offset(12, 0).Resize(.Rows.Count - 1).Select Selection.Copy dWS.Activate dWS.Cells(Rows.Count, 1).End(xlUp).Offset(12, 1).Select dWS.Paste
拙いコードですみませんが、こちらでお試しください。
(ひでお) 2020/04/15(水) 14:02
>(最後のシート)しかコピーされません。原因は何でしょうか? >Destination:=dWS.Cells(Rows.Count, 1).End(xlUp).Offset(12, 1)
オフセット元のCells(Rows.Count, 1).End(xlUp)がA列に対し、 貼付が、Offset(12, 1)でB列になっているからです。
(tkit) 2020/04/15(水) 14:43
dWS.UsedRange sWS.UsedRange
のようにどちらもUsedRangeを対象に操作されていますが、表範囲がC〜H列ならちょっと別のアプローチを考えたほうが安全じゃないですかね
(UsedRangeがA列から始まるとは限らないため)
同様に
.UsedRange.Offset(12, 0)についても、1行目から始まるとは限らないので状況によっては想定外の結果になっちゃいませんかね?
(もこな2 ) 2020/04/15(水) 15:25
画面更新しておらずただ今拝見しました。
ご返信有り難うございます。
UsedRangeを使用するとセルの対象範囲が分かりにくくになってしまうため、セルの対象範囲を別の方法(詳しくなく分かりかねるのですが)で設定してみるということでしょうか?
すみません。よろしくお願いいたします。
(ノブ) 2020/04/15(水) 16:52
Sub 実験() With ActiveSheet Debug.Print "使用範囲は " & .UsedRange.Address(False, False) & " です" & vbLf Debug.Print "対象は " & .UsedRange.Offset(12, 0).Address(False, False) & " でよろしいですか?"
Debug.Print vbLf & "それとも" Debug.Print "対象は " & Intersect(.Rows(13 & ":" & .Rows.Count), .Range("C:H"), .UsedRange.EntireRow).Address(False, False) & " ですか?" End With End Sub
(もこな2 ) 2020/04/15(水) 18:33
ご返信ありがとうございます。
実行した結果
使用範囲は C5:J15 です
対象は C17:J27 でよろしいですか?
それとも
対象は C13:H15 ですか?
となりました。
(ノブ) 2020/04/15(水) 20:11
試されてお分かりになったかとおもいますが、状況によってはUsedRangeが想定と違う範囲であることがあり得ます。
A1セルに必ず何かが入力されているという状況であればこういった問題はおこらないでしょうが、頭の片隅に入れておくとよいとおもいます。
ちなみに、13行目以降にデータがあるかどうかで判定すればよいのですからIntersectメソッドを使うというアプローチもあるとおもいます。
Sub 実験2() Dim dstRNG As Range Dim srcRNG As Range Dim SH As Worksheet
With Worksheets("本部提案シート") .Rows("13:" & .Rows.Count).Delete Set dstRNG = .Range("C13") End With
For Each SH In Worksheets If SH.Name <> dstRNG.Parent.Name Then
Set srcRNG = Intersect(SH.Rows("13:" & SH.Rows.Count), SH.Range("C:H"), SH.UsedRange.EntireRow)
If Not srcRNG Is Nothing Then srcRNG.Copy dstRNG dstRNG.Parent.Cells(dstRNG.Row, "B").Resize(srcRNG.Rows.Count).Value = srcRNG.Parent.Name
Set dstRNG = dstRNG.Offset(srcRNG.Rows.Count) End If End If Next
End Sub
(もこな2 ) 2020/04/16(木) 05:36
ご返信ありがとうございます。
UsedRangeが想定と違う範囲であることがよく分かりました。
教えていただいたIntersectメソッドを使用して確認してみます。
お忙しいところ、本当に助かりました。
ご親切に有り難うございました。
(ノブ) 2020/04/16(木) 10:17
お世話になっております。
教えて頂きましたIntersectメソッドで全てのシートが貼り付けられました!有り難うございます。
1点だけなのですが、コピー元の各シートのB列にあらかじめ1〜150までの通し番号が入力されており、おそらくB列をセルの対象範囲としているせいか、C列〜H列に入力がない行まで反映されてしまいコピーされた各シートごとにデータの間隔がB列分空いてしまいます。
C列〜H列にデータがある範囲だけをコピーして貼り付けられる方法はありますでしょうか?
お忙しいところ、重ね重ね大変申し訳ございません。お助け頂ければ幸いです。
どうぞ宜しくお願い致します。
(ノブ) 2020/04/16(木) 11:34
お世話になっております。
先ほどのコピー元の各シートの空白行までコピーされてしまう件につきまして、原因の一つとして思い付きましたのが、コピー元の各シートのデータは他のファイルから関数式で反映されており、うまく貼り付けられなかったため、一旦、各シートの関数式のデータを値貼り付けにして保存したうえでシートの集約を行っているため、B列の1〜150行までの間のC列〜H列の入力されていないセルにも何かしらのデータが入っている(空白の行をドラッグしたところセルの数をカウントしたため)と思われます。
それが原因だとするとC列〜H列を参照しても空白行もコピーされてしまうではないかと思いました。
何かしらデータの残っている空白行を飛ばしてコピーされる方法を探さなくてはならないのでしょうか?
度々申し訳ございません。
どうぞ宜しくお願い致します。
(ノブ) 2020/04/16(木) 12:11
その場合、UsedRange.EntireRowだとその行全部がはいっちゃいますね
>C列〜H列の入力されていないセルにも何かしらのデータが入っている
数式で""にしているものを値貼り付けした場合、それぞれのセルに「""」が入ってる状態になっちゃうとおもいます。
踏まえて、C13〜H列最大行までの間で、【逆順】で検索して何らかのデータが入っているセルを探してみてはどうでしょうか?
(もこな2 ) 2020/04/16(木) 13:07
ご返信ありがとうございます。助かっております。
【逆順】で並びかえたところ空白行が集まっておりました。その集まった空白行を選択し、「数式と値のクリア」を行い再度【逆順】したところ空白行はありませんでした。やはり【""】が入っているようです。
この状態ではB列でなく、C列やH列をみてセルの対象範囲を決めても空白行(見た目)はコピーされてしまうということですね。
あらかじめ空白行(見た目)を削除する何らかのマクロを組まないと解決出来ないということでしょうか?
すみません。どうぞよろしくお願い致します。
(ノブ) 2020/04/16(木) 13:34
Sub 実験() Dim MyRNG As Range
With ActiveSheet Set MyRNG = .Range("C13", .Cells(.Rows.Count, "H")).Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
If Not MyRNG Is Nothing Then .Range("C13", .Cells(MyRNG.Row, "H")).Select End If End With End Sub
(もこな2 ) 2020/04/16(木) 16:55
ご返信ありがとうございます。ご丁寧なご対応感謝しております。
教えて頂きましたマクロ文を標準モジュールに追加してマクロを実行してみたところ、空白行(見た目)を含めた集約されたデータが選択されました。ただ、集約された最後のシートの入力データの後の空白行(見た目)は選択されておりませんでした。
理解不足ですみません。チェックのやり方が正しくなければ教えてください。
よろしくお願い致します。
(ノブ) 2020/04/16(木) 18:07
↓を実行して、イミディエイトに何と表示されるか教えてください。
また、本当はどの範囲が取得できれば正解なのかも教えてください。
Sub 実験3() Dim MyRNG As Range
With ActiveSheet Set MyRNG = Intersect(.Rows("13:" & .Rows.Count), .Range("C:H"), .UsedRange.EntireRow) If Not MyRNG Is Nothing Then Debug.Print .UsedRange.Address(0, 0) Debug.Print MyRNG.Address(0, 0) Else Debug.Print "該当範囲がない" End If
Debug.Print vbLf
Set MyRNG = .Range("C13", .Cells(.Rows.Count, "H")).Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious) If Not MyRNG Is Nothing Then Debug.Print MyRNG.Address(0, 0) Debug.Print .Range("C13", .Cells(MyRNG.Row, "H")).Address(0, 0) Else Debug.Print "該当セルがない" End If End With End Sub
(もこな2 ) 2020/04/16(木) 18:45
ご連絡ありがとうございます。
お手数をおかけすみません。
イミディエイトには
B1:H462
C13:H462
H323
C13:H323
と表示されています。
申し訳ございません
宜しくお願い致します。
(ノブ) 2020/04/16(木) 19:36
(もこな2 ) 2020/04/17(金) 07:27
お手数をおかけすみません。
情報不足でした。
取得したい範囲は
(C13:H23)、(C163:H166)、(C313:H323)に入力されている3つのシートのデータです。入力されいるデータ間は空白行(見た目)となっております。
各シートには(B13:B162)の範囲で1〜150まで通し番号は入力されております。
集約シートのB列(B13:B162)、(B163:B312)、(B313:B462)には、各シートのC列のデータ(A支部、B支部、C支部と各シートで同じ内容のデータ)が反映されております。
分かりづらくすみませんが、どうぞ宜しくお願い致します。
(ノブ) 2020/04/17(金) 10:54
>3つのシート
とのことなので、仮にA、B、Cとした場合
【Aシート】
取得したい範囲 C13:H23
実験2の実行結果 B1:H462 C13:H462
H323 C13:H323
【Bシート】
取得したい範囲 C163:H166
実験2の実行結果
【Cシート】
取得したい範囲 C313:H323
実験2の実行結果
みたいに教えてもらえませんか?
集計シートのほうは今は要らない情報ですが
13 〜 162 Aシート由来 163 〜 312 Bシート由来 313 〜 462 Cシート由来
になるのが正解ということですよね?たぶん・・・
(もこな2) 2020/04/17(金) 12:36
お世話になっております。
説明が至らずすみません。
また、理解不足で意図と異なってしまうかもしれないのですが、最後に教えて頂きました実験を集計シートで実行した場合の結果は記載していただいた通りのものです。
各シートで実行した場合の結果を以下に記載します。
【Aシート】
取得したい範囲 C13:H23
実験2の実行結果 B1:H162 C13:H162
H23
C13:H23
【Bシート】
取得したい範囲 C163:H166
実験2の実行結果 B1:H162 C13:H162
H16
C13:H16
【Cシート】
取得したい範囲 C313:H323
実験2の実行結果 B1:H162 C13:H162
H23
C13:H23
となりました。
集約シートについては、記載いただいたとおりです。
宜しくお願い致します。
(ノブ) 2020/04/17(金) 14:01
【Aシート】
取得したい範囲 C13:H23 実験2の実行結果 B1:H162 C13:H162
H23 C13:H23 ←これが使える
【Bシート】
取得したい範囲 C163:H166
実験2の実行結果 B1:H162 C13:H162
H16 ←そもそもB〜H列の17行目以下に有効なデータがない C13:H16
【Cシート】
取得したい範囲 C313:H323
実験2の実行結果 B1:H162 C13:H162
H23 ←そもそもB〜H列の24行目以下に有効なデータがない C13:H23
ですから、BシートとCシートは取得(コピー)したい範囲に有効なデータが無いため、処理する必要がないように思います。
ちなみに、そもそもBシートとCシートの取得したい範囲はどうやって決めているのですか?
(もこな2) 2020/04/17(金) 14:49
いつもご回答ありがとうございます。
大変失礼致しました。取得したい範囲が集約シートで実行した結果になっておりました。
シートごとに取得したい範囲と実験結果は下記の通りです。
【Aシート】
取得したい範囲 C13:H23
実験2の実行結果 B1:H162 C13:H162
H23
C13:H23
【Bシート】
取得したい範囲 C13:H16
実験2の実行結果 B1:H162 C13:H162
H16
C13:H16
【Cシート】
取得したい範囲 C13:H23
実験2の実行結果 B1:H162 C13:H162
H23
C13:H23
となります。
BシートとCシートの取得したい範囲の決め方につきましては、申し訳ございません、よく理解しておらず教えて頂きました下記のマクロ文をそのまま使用しております。
Sub 実験2()
Dim dstRNG As Range Dim srcRNG As Range Dim SH As Worksheet With Worksheets("本部提案シート") .Rows("13:" & .Rows.Count).Delete Set dstRNG = .Range("C13") End With For Each SH In Worksheets If SH.Name <> dstRNG.Parent.Name Then Set srcRNG = Intersect(SH.Rows("13:" & SH.Rows.Count), SH.Range("C:H"), SH.UsedRange.EntireRow) If Not srcRNG Is Nothing Then srcRNG.Copy dstRNG dstRNG.Parent.Cells(dstRNG.Row, "B").Resize(srcRNG.Rows.Count).Value = srcRNG.Parent.Name Set dstRNG = dstRNG.Offset(srcRNG.Rows.Count) End If End If Next End Sub
お手数をおかけして大変申し訳ございません。
どうぞよろしくお願い致します。
(ノブ) 2020/04/17(金) 17:52
【Aシート】C13:H23 ←Findメソッドで逆順に調べれば対応可能 【Bシート】C13:H16 ←Findメソッドで逆順に調べれば対応可能 【Cシート】C13:H23 ←Findメソッドで逆順に調べれば対応可能
ってことですよね?
>BシートとCシートの取得したい範囲の決め方
ますます、意味がわからなく…
「取得したい範囲 C163:H166」のように仰っていたので、163〜166までというのは
どういうルールで決めたのか?と確認していたんです。
提示がまちがっていて、C13:H16が正しいというなら、13行目〜有効なデータがある最後の行までということですから理解できます。
いま、なにに困っているんでしたっけ…?
(もこな2) 2020/04/17(金) 20:16
いつもごお返事誠に有り難うございます。
使用したい範囲は
【Aシート】C13:H23 ←Findメソッドで逆順に調べれば対応可能 【Bシート】C13:H16 ←Findメソッドで逆順に調べれば対応可能 【Cシート】C13:H23 ←Findメソッドで逆順に調べれば対応可能 ↑
こちらの範囲のデータを集約シートにまとめたいです。
現在困っている点は、元のA〜Cシートのデータは関数式でもってきているデータのため、一旦、A〜Cシートのデータを値貼り付けにしてから集約を行っているため、入力データがないセルが[""]のような見えない文字列となり、結果、上記の使用したい範囲以外が、見た目空白となり、セルがコピーされてしまいます。
この各シートの見た目空白となっている行を除いて、上記のA〜Cシートの使用したい範囲のデータのみ集約したいということで悩んでおります。
上手く伝えられず申し訳ございません。
どうぞ宜しくお願い致します。
(ノブ) 2020/04/20(月) 11:49
うーん・・・
【Aシート】
取得したい範囲 C13:H23 ↑ 【取得できている】 C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル C13:H23
【Bシート】
取得したい範囲 C13:H16 ↑ 【取得できている】 C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル C13:H16
【B】シート
取得したい範囲 C13:H23 ↑ 【取得できている】 C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル C13:H23
もう一度聞きます。
【今】困ってるんですか?
(もこな2 ) 2020/04/20(月) 12:30
ご連絡ありがとうございます。
説明が至らずすみません。
困っている内容について、各シートで取得したい範囲のデータは集約シートに取得出来ているのですが、余分な行(空白に見える行)までコピーされてしまい、各シートの使用したいデータの間隔が130行〜140行も空いてしまいます。実際の作業では100シート分くらいを集約するため、余分な行(空白に見える行)は除いて集約したく思っております。
お忙しいところ、ご迷惑をおかけしている事を深くお詫び申し上げます。
どうぞよろしくお願い致します。
(ノブ) 2020/04/20(月) 14:34
取得したい範囲=余分な行(空白に見える行)を【除いた】もの
つまり、コピー【したい(コピーする前の)】(余分な行(空白に見える行)を除いたもの)範囲を教えてください
次に、 「C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル」で得られたセル範囲と【違っているか】教えてください
なお、貼付【後】のことは【一切考えない】でください
(もこな2 ) 2020/04/20(月) 15:15
ご返信ありがとうございます。
度々申し訳ございません。
取得したい範囲=余分な行(空白に見える行)を【除いた】もの つまり、コピー【したい(コピーする前の)】(余分な行(空白に見える行)を除いたもの)範囲を教えてください
【Aシート】
取得したい範囲 C13:H23 合っています。
【Bシート】
取得したい範囲 C13:H16 合っています。 【C】シート 取得したい範囲 C13:H23 合っています。 すみません。 宜しくお願い致します。
(ノブ) 2020/04/20(月) 16:51
ですよね・・・もう一度聞きますね。
【何に】困ってるのですか?
コピーするセル範囲の取得方法 ←理解できたのすよね? 貼付するセルの指定方法 ←元から理解できていたのですよね?
他にわからない部分があるとおもえないんですが・・・
(もこな2 ) 2020/04/20(月) 17:31
ご返信有り難うございます。
貼付するセルの指定方法 ←元から理解できていたのですよね?
すみません。こちらの点です。
各シートの取得したいセル範囲を指定する方法が分かりませんでした。
大変分かりずらい説明だったことをお許しください。
どうぞよろしくお願い致します。
(ノブ) 2020/04/20(月) 17:54
手順としてはこうなりませせん?
(1)Aシートの「C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル」をコピーする (2)本部提案シートのC13セルに(1)を貼付する
(3)Bシートの「C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル」をコピーする (4)本部提案シートのC13セルから(1)の行数分下がったところに(3)を貼付する
(5)Cシートの「C13〜Findメソッドで逆順検索して得られたセルが含まれる行のH列のセル」をコピーする (6)本部提案シートのC13セルから(3)の行数分下がったところに(5)を貼付する
このうち、【コピー対象】の(1),(3),(5)は再三説明してるので、わかってると思うんですが、
【貼付先】の(2)、(4)、(5)の部分で困ってるということですか?
(もこな2 ) 2020/04/20(月) 18:28
ご返信ありがとうございます。
矛盾した説明、大変申し訳ございませんでした。
おっしゃるとおりです。
【貼付先】の(2)、(4)、(5)についての方法とマクロ文への組み込み方が分かっておりません。
お手数ばかりおかけしてすみません。
どうぞよろしくお願い致します。
(ノブ) 2020/04/20(月) 18:57
誤 (6)本部提案シートのC13セルから(3)の行数分下がったところに(5)を貼付する 正 (6)(4)のセルから(3)の行数分下がったところに(5)を貼付する
そして、2020/04/16(木) 05:36に提示したコードをベースに必要な修正を加えればお困りのことは解決するとおもいますので、ちょっと考えてみてください。
(もこな2 ) 2020/04/20(月) 21:09
Sub 実験_改() Dim dstRNG As Range Dim srcRNG As Range Dim SH As Worksheet Dim MyRNG As Range
Stop
With Worksheets("本部提案シート") .Rows("13:" & .Rows.Count).Delete Set dstRNG = .Range("C13") End With
For Each SH In Worksheets If SH.Name <> dstRNG.Parent.Name Then
Set MyRNG = SH.Range("C13", SH.Cells(SH.Rows.Count, "H")).Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious) If MyRNG Is Nothing Then Set srcRNG = SH.Range("C13", SH.Cells(MyRNG.Row, "H"))
srcRNG.Copy dstRNG dstRNG.Parent.Cells(dstRNG.Row, "B").Resize(srcRNG.Rows.Count).Value = srcRNG.Parent.Name Set dstRNG = dstRNG.Offset(srcRNG.Rows.Count) End If End If Next End Sub
(もこな2 ) 2020/04/24(金) 10:56
でした。ごめんなさい。
(もこな2 ) 2020/04/25(土) 11:35
いつもお世話になっております。
先週21日より発熱をしてしまい、コロナウィルス感染の可能性もあるため、自宅隔離の生活を送っておりました。隔離部屋にはWi-Fi環境がなく、お返事出来なかった事をお詫び申し上げます。
20日にご返信頂き、マクロ文を追加してみながら試してみましたがエラーが出てしまい上手くいかなかった段階でした。
4月24日に頂きましたマクロ文で試してみたところ、空白となっていた行も省かれ、上手く集約することが出来ました。
本当に有り難うございました。
お忙しいところ、ご親切に面倒をみて頂き、感謝しきれない思いです。
助けて頂き本当に有り難うございました。
コロナウィルスもまだまだ終息しませんが、お体ご自愛下さい。
宜しくお願い致します。
(ノブ) 2020/04/28(火) 14:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.