Excel VBA質問箱 IV

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

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


8777 / 13646 ツリー ←次へ | 前へ→

【31064】異なる複数のブックのシート1と2からのデータの貼り付け PI 05/11/10(木) 22:50 質問[未読]
【31071】Re:異なる複数のブックのシート1と2から... Kein 05/11/11(金) 11:46 発言[未読]
【31115】Re:異なる複数のブックのシート1と2から... PI 05/11/11(金) 20:28 お礼[未読]
【31119】Re:異なる複数のブックのシート1と2から... Kein 05/11/11(金) 21:01 回答[未読]
【31134】Re:異なる複数のブックのシート1と2から... PI 05/11/11(金) 23:38 質問[未読]
【31136】Re:異なる複数のブックのシート1と2から... こたつねこ 05/11/12(土) 1:05 回答[未読]
【31137】Re:異なる複数のブックのシート1と2から... PI 05/11/12(土) 7:15 お礼[未読]
【31139】Re:異なる複数のブックのシート1と2から... こたつねこ 05/11/12(土) 8:34 発言[未読]
【31140】Re:異なる複数のブックのシート1と2から... PI 05/11/12(土) 10:06 お礼[未読]
【31214】Re:異なる複数のブックのシート1と2から... PI 05/11/14(月) 20:09 質問[未読]
【31215】Re:異なる複数のブックのシート1と2か... ponpon 05/11/14(月) 22:11 発言[未読]
【31216】Re:異なる複数のブックのシート1と2から... こたつねこ 05/11/15(火) 0:12 発言[未読]
【31219】Re:異なる複数のブックのシート1と2から... PI 05/11/15(火) 7:02 質問[未読]
【31225】Re:異なる複数のブックのシート1と2から... こたつねこ 05/11/15(火) 10:41 回答[未読]
【31261】Re:異なる複数のブックのシート1と2から... PI 05/11/15(火) 18:28 お礼[未読]

【31064】異なる複数のブックのシート1と2からの...
質問  PI  - 05/11/10(木) 22:50 -

引用なし
パスワード
   5個のブックのシート1と2からセルのデータを
一枚の「仕上げシート」に貼り付けたいのですが・・・

これに関して2点質問があります。
1.もう少しシンプルなコードに仕上げたい
2.複数のセルデータの貼りこみの仕方(コードの中の⇒です)が上手く行きません
 対応の方法
この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")を貼り付ける方法
'下の4行も複数のセルデータを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:異なる複数のブックのシート1と2か...
発言  Kein  - 05/11/11(金) 11:46 -

引用なし
パスワード
   各ブックのSheet(1)、Sheets(2)の名前は何でしょうか ?
それが分かれば、ブックを開かなくてもリンクやDAOで値を引っ張ることが出来ます。

【31115】Re:異なる複数のブックのシート1と2か...
お礼  PI  - 05/11/11(金) 20:28 -

引用なし
パスワード
   ▼Kein さん:

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

>それが分かれば、ブックを開かなくてもリンクやDAOで値を引っ張ることが出来ます。
ブックを開かなく異なるブックからセルデータを貼り付ける方法があるのですか。
是非教えていただきたく宜しくお願いいたします。

【31119】Re:異なる複数のブックのシート1と2か...
回答  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:異なる複数のブックのシート1と2か...
質問  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の列は各ブック(5つのブック)のシート2のA1のデータを貼り付けています。

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

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

もし、問題点が分かりましたら、またご教示お願いします。

【31136】Re:異なる複数のブックのシート1と2か...
回答  こたつねこ  - 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:異なる複数のブックのシート1と2か...
お礼  PI  - 05/11/12(土) 7:15 -

引用なし
パスワード
   ▼こたつねこ さん
ご解答ありがとうございました。
シンプルな構文で喜んでおります。

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

大変お世話になりました。

【31139】Re:異なる複数のブックのシート1と2か...
発言  こたつねこ  - 05/11/12(土) 8:34 -

引用なし
パスワード
   PIさん、おはようございます。

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

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

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

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

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

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

Set Book(6) = Workbooks.Open(ThisWorkbook.Path & "\A666.xls")
を追記すれば6つのBookを参照したい場合でも動きます。

【31140】Re:異なる複数のブックのシート1と2か...
お礼  PI  - 05/11/12(土) 10:06 -

引用なし
パスワード
   ▼こたつねこ さん:

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

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

これからも宜しくお願いします。

【31214】Re:異なる複数のブックのシート1と2か...
質問  PI  - 05/11/14(月) 20:09 -

引用なし
パスワード
   今晩は。

こたつねこ さんには、色々とご指導いただき、理解できたつもりでおりますが。
また、質問させていただきます。
下記のコードで、「異なる複数のブックからデータを張り付け」ようと
したのですが、9行目で
実行時エラー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:異なる複数のブックのシート1と2か...
発言  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:異なる複数のブックのシート1と2か...
発言  こたつねこ  - 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:異なる複数のブックのシート1と2か...
質問  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:異なる複数のブックのシート1と2か...
回答  こたつねこ  - 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:異なる複数のブックのシート1と2か...
お礼  PI  - 05/11/15(火) 18:28 -

引用なし
パスワード
   ▼こたつねこ さん:

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

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

また宜しくご指導の程お願いいたします。

8777 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free