Excel VBA 質問スレッド No.200 (解決済)

セルの値からシートを検索してデータを取得してコピペする

投稿者 : きみどり     投稿日時 : 2021/03/23(Tue) 18:08:04     OS : Windows 10     EXCEL : Excel 2016
当方、VBA初心者です。VBAで複数シートからの複数セルのデータを取得して1枚のシートにまとめたいと思っていますがうまく機能しません。構成は次の通りです。

シート;Report "とりまとめのシート
シートあ、い、う "データのあるシート

Reportシートの”あ”のある行のG2セルから横に、”シートあ”から取得したデータを行列を入れ替えて値のみ貼り付けたいです。よろしくお願いいたします。


Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")

With wsMRD
i = 0
Do
strSN = Cells(2 + i, "B").Value
If strSN = "" Then Exit Do
Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
Selection.Copy
.Range("G2").PasteSpecial Paste:=xlPasteValues, Transpose:=True


i = i + 1
Loop
End With
End Sub

[返信 1] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : ヘンリー     投稿日時 : 2021/03/23(Tue) 21:13:50
>うまく機能しません。
まずは、うまく機能するかしないかの前に、文法エラーがあります。
初心者であれば、エラーを無視してはいけません。
(慣れている人ならば、エラーの内容を見なくても、コードを見て修正できます)

コンピュータが、わざわざ「○〇エラー」と返してきてくれているのですから、
そのエラーについて調べてみる事が大切です。
これをしないと、VBAはできるようにはなりません。

>Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
ダブルコーテーションの意味、使い方について調べてみて下さい。
ActiveのシートでなければSelectメソッドはできません。

【蛇足】
厳密にいうと、Worksheets("Report")とSheets(strSN)のシートには違いがあります。
Sheetsの中に、Worksheetsがあり、初期状態からある"Sheet1"という名前のシートは、Worksheetです。
Sheetsの中には、Excel4.0マクロシートなどが含まれているのです。
シート名の所で、右クリックの挿入を選んでみて下さい。
そこに出てくるものは、全てSheetです。そして、その中にWorksheetがあります。

[返信 2] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : きみどり     投稿日時 : 2021/03/24(Wed) 09:47:16
■[返信 1] ヘンリーさん(2021-03-23 21:13:50)の記事
> >うまく機能しません。
> まずは、うまく機能するかしないかの前に、文法エラーがあります。
> 初心者であれば、エラーを無視してはいけません。
> (慣れている人ならば、エラーの内容を見なくても、コードを見て修正できます)

> コンピュータが、わざわざ「○〇エラー」と返してきてくれているのですから、
> そのエラーについて調べてみる事が大切です。
> これをしないと、VBAはできるようにはなりません。

> >Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
> ダブルコーテーションの意味、使い方について調べてみて下さい。
> ActiveのシートでなければSelectメソッドはできません。

> 【蛇足】
> 厳密にいうと、Worksheets("Report")とSheets(strSN)のシートには違いがあります。
> Sheetsの中に、Worksheetsがあり、初期状態からある"Sheet1"という名前のシートは、Worksheetです。
> Sheetsの中には、Excel4.0マクロシートなどが含まれているのです。
> シート名の所で、右クリックの挿入を選んでみて下さい。
> そこに出てくるものは、全てSheetです。そして、その中にWorksheetがあります。

ヘンリーさん
ありがとうございます!
何度も修正を繰り返した挙句に、投稿させていただいたのですが
> >Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
こちらは、この投稿に書き写す際にダブってしまいましたので、実際の構文では1つのみです。

> ActiveのシートでなければSelectメソッドはできません。
こちらについても、copyに変えたりしたのですが、そうすると「インデックスが有効範囲にありません」とデバックが返り、Rangeが有効でないのだなとは思ったのですが、その先へ進めませんでした。

> 【蛇足】
このWorksheetsとSheetsの関係が全く理解できませんでした。
strSNをStringとしたのは、インデックスでなくシートの名前を代入したかったためなのですが、最初はas Worksheetとしておりました。Stringに変更してようやく代入できたようなのですが、今度ははRangeオブジェクトで引っかかってしまっております。

長々と書いてしまいましたが、本日もまた構文と戦っていきますので、さらなるヒントがありましたらご教授ください。

[返信 3] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : ヘンリー     投稿日時 : 2021/03/24(Wed) 13:57:52
Sub Sample()



Dim i As Long

Dim wsMRD As Worksheet

Dim strSN As String



Set wsMRD = Worksheets("Report")



With wsMRD

i = 0

Do

strSN = Cells(2 + i, "B").Value

If strSN = "" Then Exit Do

Worksheets(strSN).Select

Range("L3:L4,L7:L15,L18:L19").Select

Selection.Copy

.Range("G2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

i = i + 1

Loop

End With

End Sub




>「インデックスが有効範囲にありません」

このエラーは、該当のワークシートが見つからない時に出ます。

Copyに変えたからではないと思いますが、私にはいまいちわかりません。すいません。



>このWorksheetsとSheetsの関係が全く理解できませんでした。

説明が良くなかったようです。すいません。

VBAとは関係なく、シート名の所で右クリックして挿入してみて下さい。(+記号ではなく、ワークシート名の所で挿入)

すると、挿入というウィンドが表示されます。このウィンドに表示されている物がSheetsです。

Sheetsには、Worksheetsも入っていますが、グラフというシートや、Excel4.0マクロなどというシートも入っています。



上記のコードで、ご希望通り動くか試してみて下さい。

又、上記コードをコピー&ペーストしtも良いですが、

必ず1回は、ステップイン実行をして、1行1行結果を確認する作業をして下さい。

私もステップイン実行で覚えていきましたし、この手間をかける人は、

皆VBAができるようになっています。

この手間を省く人は、できるようになる人は少ないです。



>本日もまた構文と戦っていきますので

是非、頑張ってください。応援しております。

[返信 4] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : きみどり     投稿日時 : 2021/03/24(Wed) 16:46:56
ヘンリーさん
再びご返信いただきありがとうございます!!!ステップ実行とアドバイスにより、走るようになりました!
>「インデックスが有効範囲にありません」
おっしゃる通り、該当のワークシートが見つからない時のデバックでした。
SELECTでなくCOPYのまま、「Application.ScreenUpdating」というものを入れ込んでみました。
またシート名で挿入の箇所を確認してみました。おっしゃる通りグラフやExcel4.0マクロが入っていました。
WorksheetsとSheetsの関係については、引き続き勉強していきます。

ですが、もう一つ、「On Error Resume Next」としたためか、エラーの行には直前の処理データが入るようになってしまいました。
エラーを無視して(エラー行は空白のまま)次に行ってほしいのですが、
このエラー処理について、アドバイスいただけると嬉しいです。

Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")
On Error Resume Next

Application.ScreenUpdating = False
With wsMRD

i = 0

Do
strSN = Cells(2 + i, "B").Value
If strSN = "" Then Exit Do
Sheets(strSN).Range("L3:L4,L7:L15,L18:L19").Copy
.Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True


i = i + 1
Loop
End With
Application.ScreenUpdating = True
End Sub

[返信 5] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : ヘンリー     投稿日時 : 2021/03/24(Wed) 21:51:06
大変申し訳ございません。
私の頭の悪さでは、On Error Resume Nextは使いこなせません。

>エラーの行には直前の処理データが入るようになってしまいました。
このことから、コピーの時にエラーが発生して、
コピーはできずにペーストしてしまっているのかと思いましたが、
エラーが発生した時点で、Application.CutCopyMode = Falseになっていたので、
当方で試したところ、直前の処理データは入らず、セルには何も入りませんでした。

ちなみに、Application.CutCopyModeとは、
Trueなら右クリックでコピーしたときに、セルが点線で囲まれて表示されていれる状態
Falseなら右クリックでコピーしたときに、セルが点線で囲まれて表示されていない状態の事です。

きみどり様は、頑張っておられるので、何とかお力になれればと思うのですが…

私は、On Error Resume Nextは使いません。
参考までに、私が始めたての頃に使っていたエラー処理方法のサンプルを載せます。

Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

On Error GoTo Sheet_Err
Set wsMRD = Worksheets("Report")

Application.ScreenUpdating = False
With wsMRD

i = 0

Do

strSN = Cells(2 + i, "B").Value
If strSN = "" Then Exit Do

On Error GoTo Copy_Err
Sheets(strSN).Range("L3:L4,L7:L15,L18:L19").Copy
On Error GoTo Paste_Err
.Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True

Next_Process:
i = i + 1
Loop
End With
Application.ScreenUpdating = True
On Error GoTo 0

Exit Sub

Sheet_Err:
MsgBox Err.Description, vbExclamation
Exit Sub

Copy_Err:
MsgBox Err.Description, vbExclamation
Resume Next_Process

Paste_Err:
MsgBox Err.Description, vbExclamation
Resume Next_Process

End Sub

この方法だと、どの命令でエラーが発生したかが分かりやすく、
エラーの内容も分かるので、エラーの対応がやりやすいのと、
戻りの位置も確実に指定できることです。

ただし、ループの中から一旦出てから、またループの中に戻るので、
第三者が修正する可能性がある場合は、嫌われるコードです。

エラーが出る可能性のある命令については、プロシージャを分けるという方法があります。
Sub Main()
Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")
On Error Resume Next

Application.ScreenUpdating = False
With wsMRD

i = 0

Do
strSN = Cells(2 + i, "B").Value
If strSN = "" Then Exit Do
If CopyRange(Sheets(strSN).Range("L3:L4,L7:L15,L18:L19")) = True Then
.Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If

i = i + 1
Loop
End With
Application.ScreenUpdating = True

End Sub

Function CopyRange(rngRange As Range) As Boolean
On Error GoTo Err_Exit

CopyRange = False

rngRange.Copy

CopyRange = True
Exit Function

Err_Exit:
MsgBox Err.Description

End Function

[返信 6] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : きみどり     投稿日時 : 2021/03/25(Thu) 11:31:52
ヘンリーさん
素敵なエラー処理例をいただき、本当にありがとうございます!!

>当方で試したところ、直前の処理データは入らず、セルには何も入りませんでした。
という記載に驚きました。同じコードでも別の結果が返ってくるとは、、、本当に奥が深いです。。

コピペするデータが他に複数あり、当方の処理に合うものを頂いたエラー処理サンプルで検証してみます。
まずは、ヘンリーさんのご協力に本当に感謝いたします!!!!!

[返信 7] Re : セルの値からシートを検索してデータを取得してコピペする
投稿者 : きみどり     投稿日時 : 2021/03/30(Tue) 16:37:44
ヘンリーさん
大変遅くなりましたが、最初にご教示いただいたエラー処理の方で解決に至りました。当方には理解しやすく、おっしゃる通りエラー箇所が分かりやすいため修正しやすかったです。
大変参考になりました。ありがとうございました。

当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2021-04-21 08:22:55 )

Page
Top