Excel VBA質問箱 IV

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

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


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

824 / 76735

←次へ　｜　前へ→


	【81573】Re:VBA データが多い場合

［名前なし］ - 20/12/12(土) 20:15 -


	引用なし

	パスワード

Sub deta()

Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim forNo As Variant, toNo() As Variant
Dim setRow As Integer, cMax As Integer
Dim aRange As Range, bRange As Range
Dim toRow As Integer, toCol As Integer
Dim i As Double, foi As Double, toi As Double, n As Integer

forNo = Array("A1", "C1", "G1", "B1") 'コピー元（Sh1）のセル位置
toNo = Array("A1", "B1", "C1", "B2")　'コピー先(Sh2）のセル位置
setRow = 2　　　　　　　　　　　　　　'コピー先１セットの行数

cMax = UBound(forNo)
Set Sh1 = ThisWorkbook.Sheets("シート１")
Set Sh2 = ThisWorkbook.Sheets("シート２")

Set aRange = Sh1.Range("A1").CurrentRegion '元データー範囲
'Set aRange = Intersect(aRange, aRange.Offset(1, 0)) '１行目を省く
Set aRange = Intersect(aRange, aRange.Columns(1)) 'A列に絞る
'aRangeのセル数（行数）分転記する。
Sh2.Range("A1:ZZ1000").ClearContents　　　'転記先をクリアー？

For Each bRange In aRange
　 i = bRange.Rows.Row
　 foi = i - 1
　 toi = foi * setRow
　　 Debug.Print bRange.Address, i, toi
　 For n = 0 To cMax
　　　Sh2.Range(toNo(n)).Offset(toi, 0).Value = Sh1.Range(forNo(n)).Offset(foi, 0).Value
　 Next
Debug.Print bRange.Address, i, toi
Next

Set aRange = Nothing
Set bRange = Nothing
Set Sh1 = Nothing
Set Sh2 = Nothing

End Sub

1 hits

▼

【81571】VBA データが多い場合 ゆきだるま 20/12/11(金) 14:52