Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8777 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【31064】異なる複数のブックのシート１と２からのデータの貼り付け PI 05/11/10(木) 22:50 質問[未読]
【31071】Re:異なる複数のブックのシート１と２から... Kein 05/11/11(金) 11:46 発言[未読]
【31115】Re:異なる複数のブックのシート１と２から... PI 05/11/11(金) 20:28 お礼[未読]
【31119】Re:異なる複数のブックのシート１と２から... Kein 05/11/11(金) 21:01 回答[未読]
【31134】Re:異なる複数のブックのシート１と２から... PI 05/11/11(金) 23:38 質問[未読]
【31136】Re:異なる複数のブックのシート１と２から... こたつねこ 05/11/12(土) 1:05 回答[未読]
【31137】Re:異なる複数のブックのシート１と２から... PI 05/11/12(土) 7:15 お礼[未読]
【31139】Re:異なる複数のブックのシート１と２から... こたつねこ 05/11/12(土) 8:34 発言[未読]
【31140】Re:異なる複数のブックのシート１と２から... PI 05/11/12(土) 10:06 お礼[未読]
【31214】Re:異なる複数のブックのシート１と２から... PI 05/11/14(月) 20:09 質問[未読]
【31215】Re:異なる複数のブックのシート１と２か... ponpon 05/11/14(月) 22:11 発言[未読]
【31216】Re:異なる複数のブックのシート１と２から... こたつねこ 05/11/15(火) 0:12 発言[未読]
【31219】Re:異なる複数のブックのシート１と２から... PI 05/11/15(火) 7:02 質問[未読]
【31225】Re:異なる複数のブックのシート１と２から... こたつねこ 05/11/15(火) 10:41 回答[未読]
【31261】Re:異なる複数のブックのシート１と２から... PI 05/11/15(火) 18:28 お礼[未読]
【31064】異なる複数のブックのシート１と２からの...
質問  PI  - 05/11/10(木) 22:50 -
引用なし
パスワード
   5個のブックのシート１と２からセルのデータを
一枚の「仕上げシート」に貼り付けたいのですが･･･

これに関して２点質問があります。
1.もう少しシンプルなコードに仕上げたい
2.複数のセルデータの貼りこみの仕方(コードの中の⇒です）が上手く行きません
　対応の方法
この２件について教えてください。

現在のコードは

　Dim 一枚仕上げ As Workbook
　　Dim A111 As Workbook
　　Dim A222 As Workbook
　　Dim A333 As Workbook
　　Dim A444 As Workbook
　　Dim A555 As Workbook
　　
　　On Error Resume Next
　　Set 一枚仕上げ = ThisWorkbook
　　Set A111 = Workbooks.Open(ThisWorkbook.Path & "\A111.xls")
　　Set A222 = Workbooks.Open(ThisWorkbook.Path & "\A222.xls")
　　Set A333 = Workbooks.Open(ThisWorkbook.Path & "\A333.xls")
　　Set A444 = Workbooks.Open(ThisWorkbook.Path & "\A444.xls")
　　Set A555 = Workbooks.Open(ThisWorkbook.Path & "\A555.xls")
　　　　　　　
　　 With 一枚仕上げ.Sheets(1)
　　　 .Range("B5").Value = A111.Sheets(1).Range("A1:B1")
'質問2.⇒上の行B5にBookA111のRange("A1:B1")を貼り付ける方法
'下の４行も複数のセルデータをB列に貼り付けたいのですが、現在は出来ていません。
　　　 .Range("B6").Value = A222.Sheets(1).Range("A1")
　　　 .Range("B7").Value = A333.Sheets(1).Range("A1")
　　　 .Range("B8").Value = A444.Sheets(1).Range("A1")
　　　 .Range("B9").Value = A555.Sheets(1).Range("A1")
　　　
　　　 .Range("D5").Value = A111.Sheets(2).Range("A1")
　　　 .Range("D6").Value = A222.Sheets(2).Range("A1")
　　　 .Range("D7").Value = A333.Sheets(2).Range("A1")
　　　 .Range("D8").Value = A444.Sheets(2).Range("A1")
　　　 .Range("D9").Value = A555.Sheets(2).Range("A1")
　　 End With
　　　　
　　A111.Close False
　　A222.Close False
　　A333.Close False
　　A444.Close False
　　A555.Close False
　　
　　Set A111 = Nothing
　　Set A222 = Nothing
　　Set A333 = Nothing
　　Set A444 = Nothing
　　Set A555 = Nothing
　　On Error GoTo 0
　　
以上です。宜しくお願いします。
【31071】Re:異なる複数のブックのシート１と２か...
発言  Kein  - 05/11/11(金) 11:46 -
引用なし
パスワード
   各ブックのSheet(1)、Sheets(2)の名前は何でしょうか ?
それが分かれば、ブックを開かなくてもリンクやDAOで値を引っ張ることが出来ます。
【31115】Re:異なる複数のブックのシート１と２か...
お礼  PI  - 05/11/11(金) 20:28 -
引用なし
パスワード
   ▼Kein さん：

早速の返信ありがとうございます。
>各ブックのSheet(1)、Sheets(2)の名前は何でしょうか ?
シート名は現在つけておりません。
シート(１）を「日計A」、シート(２)を「日計B」にさせていただきたいと
思います。

>それが分かれば、ブックを開かなくてもリンクやDAOで値を引っ張ることが出来ます。
ブックを開かなく異なるブックからセルデータを貼り付ける方法があるのですか。
是非教えていただきたく宜しくお願いいたします。
【31119】Re:異なる複数のブックのシート１と２か...
回答  Kein  - 05/11/11(金) 21:01 -
引用なし
パスワード
   ベタ書きしますので、エラーがあったら報告して下さい。
リンクを張って値を持ってくるコードです。

Sub Test_Link()
　 Dim i As Integer, j As Integer
　 Dim LkS1 As String, LkS2 As String
　 Dim Flg As Boolean

　j = 5
　 For i = 111 To 555 Step 111
　　　With ThisWorkbook
　　　　 LkS1 = "='" & .Path & "\[A" & i & ".xls]日報A'!"
　　　　 LkS2 = "='" & .Path & "\[A" & i & ".xls]日報B'!A1"
　　　　 With .Worksheets(1)
　　　　　　If Flg = False Then
　　　　　　　 .Cells(j, 27).Formula = LkS1 & "A1"
　　　　　　　 .Cells(j, 28).Formula = LkS1 & "B1"
　　　　　　　 .Cells(j, 2).Value = _
　　　　　　　 .Cells(j, 27).Value & .Cells(j, 28).Value
　　　　　　　 Flg = True
　　　　　　Else
　　　　　　　 .Cells(j, 2).Formula = LkS1 & "A1"
　　　　　　　 .Cells(j, 4).Formula = LkS2
　　　　　　End If
　　　　 End With
　　　End With
　　　j = j + 1
　 Next i
　 With ThisWorkbook.Worksheets(1)
　　　.Cells.Copy
　　　.Range("A1").PasteSpecial xlPasteValues
　　　.Tange("AA:AB").ClearContents
　 End With
　 Application.CutCopyMode = False
End Sub
【31134】Re:異なる複数のブックのシート１と２か...
質問  PI  - 05/11/11(金) 23:38 -
引用なし
パスワード
   ▼Kein さん：

早速ご解答ありがとうございます。

>ベタ書きしますので、エラーがあったら報告して下さい。
>リンクを張って値を持ってくるコードです。

リンクを張って値を持ってくるような体験が無いもので

当方の伝え方が悪いような感じです。


最終の仕上がりは
　　A　　　　　　B　　　　　C　　　　　　D
4　ブック名　　項目1　　　項目2　　　　項目3
5　A1111　　　111　　　　1111　　　　　555
6　A2222　　　222　　　　2222　　　　　444　
7　A3333　　　333　　　 3333　　　　　 333
8　A4444　　　444　　　 4444　　　　　 222
9　A5555　　　555　　　　5555　　　　　111

上が仕上がりの状態です。

元データとこの仕上がりの表との関連は
5つのブックがあり
ブックA1111のA1とB1のデータをこの仕上がり表のB5とC5に貼り付ける
ブックA2222のA1とB1のデータをこの仕上がり表のB6とC6に貼り付ける
以下A5555まで同じ処理です。
項目3の列は各ブック(５つのブック）のシート2のA1のデータを貼り付けています。

ここの元データは常時変動するもので、現在は仮の数字で、このような
規則性はありません。
またブックの名前も仮の名前で規則性はありません。
（お伝えするのが遅くなりました）

頂いたコードでテストする限り、一寸説明できない状態です。
日報AのSheet1から３の選択の窓が出てきて選択するも、データの貼り付けが
１ケずつでマニュアル的、張り付いた値も正しくない数字になります。
う〜ん一寸表現のしようが無いです。
そしてエラーになるのですが･･･

もし、問題点が分かりましたら、またご教示お願いします。
【31136】Re:異なる複数のブックのシート１と２か...
回答  こたつねこ  - 05/11/12(土) 1:05 -
引用なし
パスワード
   PIさん、Keinさん
こんばんは、横レス失礼します。

基本はPIさんのコードをそのまま使って、こんな感じでどうですか？

Dim Book(1 To 5) As Workbook
Dim i　 As Integer

On Error Resume Next
Set Book(1) = Workbooks.Open(ThisWorkbook.Path & "\A111.xls")
Set Book(2) = Workbooks.Open(ThisWorkbook.Path & "\A222.xls")
Set Book(3) = Workbooks.Open(ThisWorkbook.Path & "\A333.xls")
Set Book(4) = Workbooks.Open(ThisWorkbook.Path & "\A444.xls")
Set Book(5) = Workbooks.Open(ThisWorkbook.Path & "\A555.xls")
　　　
For i = 1 To UBound(Book, 1)
　　With ThisWorkbook.Sheets(1)
　　　 .Range(.Cells(i + 5, 2), .Cells(i + 5, 3)).Value = _
　　　　　　　　　　　Book(i).Sheets(1).Range("A1:B1").Value

　　　 .Range(.Cells(i + 4, 4), .Cells(i + 4, 5)).Value = _
　　　　　　　　　　　Book(i).Sheets(2).Range("A1:B1").Value
　　 End With
Next i
　　
For i = 1 To 5
　　Book(i).Close False: Set Book(i) = Nothing
Next i
　
On Error GoTo 0
【31137】Re:異なる複数のブックのシート１と２か...
お礼  PI  - 05/11/12(土) 7:15 -
引用なし
パスワード
   ▼こたつねこ さん
ご解答ありがとうございました。
シンプルな構文で喜んでおります。

コードで「For i = 1 To UBound(Book, 1)」に関して
勉強不足で、これからHELPで調べようと思っています。
何かこの構文でアドバイスが有りましたらお願いします。

大変お世話になりました。
【31139】Re:異なる複数のブックのシート１と２か...
発言  こたつねこ  - 05/11/12(土) 8:34 -
引用なし
パスワード
   PIさん、おはようございます。

>コードで「For i = 1 To UBound(Book, 1)」に関して
>勉強不足で、これからHELPで調べようと思っています。

For i=1 to 5
でもOKです。

すいません、癖で使ってしまいました^^;
筆不精のためうまく説明できてない可能性が高いため、
必ずご自分でHelpで確認してくださいね。

Bookが増えた場合に変更点を少なくするため配列の要
素数の最大値を取得してループさせてます。

なのでBookが６つに増えた場合

>Dim Book(1 To 5) As Workbook
これを
Dim Book(1 to 6) as WorkBook
に変更して

Set Book(6) = Workbooks.Open(ThisWorkbook.Path & "\A666.xls")
を追記すれば６つのBookを参照したい場合でも動きます。
【31140】Re:異なる複数のブックのシート１と２か...
お礼  PI  - 05/11/12(土) 10:06 -
引用なし
パスワード
   ▼こたつねこ さん：

ありがとうございました。
UBoundの使い方の勉強が出来ました。
Helpも見ましたが貴殿のご丁寧な解説があってはじめて
理解が進みました。

非常に勉強になりました。
ご提示いただいた構文をしっかりと頭に入れて
今後活用させていただきます。

これからも宜しくお願いします。
【31214】Re:異なる複数のブックのシート１と２か...
質問  PI  - 05/11/14(月) 20:09 -
引用なし
パスワード
   今晩は。

こたつねこ さんには、色々とご指導いただき、理解できたつもりでおりますが。
また、質問させていただきます。
下記のコードで、「異なる複数のブックからデータを張り付け」ようと
したのですが、９行目で
実行時エラー91
「オブジェクトの変数またはWithブロックの変数が設定されていません。」
のエラーメッセージが出ます。色々と考えて、コードの書き換えを試みましたが
対処方法がつかめません。分かりましたら、教えてください。

Sub test3()

Dim BK(1 To 5) As Workbook
Dim i　 As Integer
Set BK1 = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
Set BK2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xls")
Set BK3 = Workbooks.Open(ThisWorkbook.Path & "\Book3.xls")
Set BK4 = Workbooks.Open(ThisWorkbook.Path & "\Book4.xls")
Set BK5 = Workbooks.Open(ThisWorkbook.Path & "\Book5.xls")
For i = 1 To UBound(BK, 1)
　　With ThisWorkbook.Sheets(1)
　　　 .Range(.Cells(5, i + 1), .Cells(24, i + 1)).Value = _
　　　　 BK(i).Sheets(1).Range(Cells(2, i), Cells(24, i)).Value
　　End With
Next i
　
For i = 1 To 5
　　BK(i).Close False: Set BK(i) = Nothing
Next i

End Sub
【31215】Re:異なる複数のブックのシート１と２か...
発言  ponpon  - 05/11/14(月) 22:11 -
引用なし
パスワード
   こんばんは。
横から失礼します。
>Set BK1 = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
>Set BK2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xls")
>Set BK3 = Workbooks.Open(ThisWorkbook.Path & "\Book3.xls")
>Set BK4 = Workbooks.Open(ThisWorkbook.Path & "\Book4.xls")
>Set BK5 = Workbooks.Open(ThisWorkbook.Path & "\Book5.xls")

を

Set BK(1) = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
Set BK(2) = Workbooks.Open(ThisWorkbook.Path & "\Book2.xls")
Set BK(3) = Workbooks.Open(ThisWorkbook.Path & "\Book3.xls")
Set BK(4) = Workbooks.Open(ThisWorkbook.Path & "\Book4.xls")
Set BK(5) = Workbooks.Open(ThisWorkbook.Path & "\Book5.xls")

に、しないと配列にならないからじゃないかなー。

違ったらごめんね。
【31216】Re:異なる複数のブックのシート１と２か...
発言  こたつねこ  - 05/11/15(火) 0:12 -
引用なし
パスワード
   PIさん、ponponさん、こんばんは

ponponさんのご指摘どおり

>Set BK(1) = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
>Set BK(2) = Workbooks.Open(ThisWorkbook.Path & "\Book2.xls")
>Set BK(3) = Workbooks.Open(ThisWorkbook.Path & "\Book3.xls")
>Set BK(4) = Workbooks.Open(ThisWorkbook.Path & "\Book4.xls")
>Set BK(5) = Workbooks.Open(ThisWorkbook.Path & "\Book5.xls")
>
>に、しないと配列にならないからじゃないかなー。
>
>違ったらごめんね。

で動きますよ。
【31219】Re:異なる複数のブックのシート１と２か...
質問  PI  - 05/11/15(火) 7:02 -
引用なし
パスワード
   ▼こたつねこ さん、ponponさん、
配列には（）が要るのですか。ありがとうございます。

おはようございます。
やはり、下のコードのところでエラーがでます。
何かコードで間違っているところがあるのでしょうか。

それとも
変数が両方のブックにかかっていて無理なんでしょうか。

With ThisWorkbook.Sheets(1)
　　　 .Range(.Cells(5, i + 1), .Cells(24, i + 1)).Value = _
　　　　 BK(i).Sheets(1).Range(Cells(2, i), Cells(24, i)).Value
End With
【31225】Re:異なる複数のブックのシート１と２か...
回答  こたつねこ  - 05/11/15(火) 10:41 -
引用なし
パスワード
   PIさん、よくコードを見てませんでした。
ごめんさい

>With ThisWorkbook.Sheets(1)
>　　　 .Range(.Cells(5, i + 1), .Cells(24, i + 1)).Value = _
>　　　　 BK(i).Sheets(1).Range(Cells(2, i), Cells(24, i)).Value
>End With

参照元と参照先の大きさが違いますよ、それと上記のような書き方を
する場合

BK(i).Sheets(1).Range(BK(i).Sheets(1).Cells(5, i), BK(i).Sheets(1).Cells(24, i)).Value

としてやらないと、エラーになります。

With ThisWorkbook.Sheets(1)
　　　 .Range(.Cells(5, i + 1), .Cells(24, i + 1)).Value = _
　　　　 BK(i).Sheets(1).Range(BK(i).Sheets(1).Cells(5, i), BK(i).Sheets(1).Cells(24, i)).Value
End With

でお試しください。
【31261】Re:異なる複数のブックのシート１と２か...
お礼  PI  - 05/11/15(火) 18:28 -
引用なし
パスワード
   ▼こたつねこ さん：

ありがとうございました。今見させていただきました。
間違いなく動きました。これで早速仕事に生かせそうです。

なるほどとまで納得まではいきませんでしたが、このような
コードを書かないとだめなんだ･･･とおぼろげに理解しました。
これからしっかりと勉強します。

また宜しくご指導の程お願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8777 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free