Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

53510 / 76732

←次へ　｜　前へ→


	【28035】Re:３段組のデータを２段組に仕上げる

kobasan - 05/8/26(金) 22:38 -


	引用なし

	パスワード

▼YN62 さん　今晩は。

確かめてないのですが、これでできると思います。

Sub 異なる表組みへの転記()
Dim k As Integer
Dim r1 As Range, r2 As Range
Dim 範囲11 As Range, 範囲12 As Range, 範囲13 As Range
Dim 範囲21 As Range, 範囲22 As Range
Dim UnionRng1 As Range, UnionRng2 As Range

　　'ブックを見えないようにする
　　Application.ScreenUpdating = False
　　destFolder = "c:\集計"　'<===============環境に合わせて変更してください
　　Workbooks.Open Filename:=destFolder & "\得点１.xls"
　　ThisWorkbook.Activate
　　'
　　With ThisWorkbook.Sheets("Sheet1")
　　　　Set 範囲11 = .Range("A4", .Cells(65536, "A").End(xlUp).Offset(-1))
　　　　Set 範囲12 = .Range("C4", .Cells(65536, "C").End(xlUp).Offset(-1))
　　　　Set 範囲13 = .Range("E4", .Cells(65536, "E").End(xlUp).Offset(-1))
　　End With
　　With Workbooks("得点１").Sheets("Sheet2")
　　　　Set 範囲21 = .Range("A2", .Cells(65536, "A").End(xlUp).Offset(-1))
　　　　Set 範囲22 = .Range("D2", .Cells(65536, "D").End(xlUp).Offset(-1))
　　End With
　　'
　　Set UnionRng1 = Union(範囲11, 範囲12, 範囲13)
　　Set UnionRng2 = Union(範囲21, 範囲22)
　　
　　'UnionRng2.Offset(, 1).ClearContents
　　'
　　For Each r1 In UnionRng1
　　For Each r2 In UnionRng2
　　　　If r1.Value = r2.Value Then
　　　　　　r2.Offset(, 1).Value = r1.Offset(, 1).Value
　　　　End If
　　Next
　　Next
　　'
　　Workbooks("得点１").Close False
　　'
　　Set 範囲11 = Nothing
　　Set 範囲12 = Nothing
　　Set 範囲13 = Nothing
　　'
　　Set 範囲21 = Nothing
　　Set 範囲22 = Nothing
　　Set UnionRng1 = Nothing
　　Set UnionRng2 = Nothing
End Sub

>又、質問で申し訳けありません。
>
>ご解答いただいたコードの続きですが・・・
>シート2が異なるブックにある場合に、コードをどのように
>書けば良いのでしょうか？
>
>シート2が「集計」というホルダ－の「得点１」と言うブックに
>あると仮定した場合のコードを教えていただけませんでしょうか。
>
>よろしくお願いいたします。

1 hits

▼

【27980】３段組のデータを２段組に仕上げる YN62 05/8/25(木) 21:13