Excel VBA質問箱 IV

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

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


38087 / 76732 ←次へ | 前へ→

【43788】Re:複雑な(?)転記
発言  ゆと  - 06/10/25(水) 19:05 -

引用なし
パスワード
   Sheet2に以下の様にデータを入れて、Sheet3に転記するサンプルを作ってみました。
定数を適当にいじってみてください。

   A   B
1 name Value
2  a  300
3  b  100
4  c  50
5  d  175
6  e  25
7  f  210


Sub Sample1()
 Dim EndRow&, TRange As Range
 Dim T_Sheet As Worksheet, P_Sheet As Worksheet
 Const T1Col$ = "A", T2Col$ = "B"
 Const P1Col$ = "A", P2Col$ = "D"
 Const StaRow& = 2, PasRow& = 2
 Const B_Line& = 5
 Set T_Sheet = Sheets("Sheet2")
 Set P_Sheet = Sheets("Sheet3")
  
 EndRow& = T_Sheet.Cells(65536, T1Col$).End(xlUp).Row
  
 With T_Sheet
  If EndRow& > B_Line& Then
   Set TRange = .Range(.Cells(B_Line& + 1, T1Col$), _
               .Cells(EndRow&, T2Col$))
   TRange.Copy Destination:=P_Sheet.Cells(PasRow&, P2Col$)
   Set TRange = .Range(.Cells(StaRow&, T1Col$), .Cells(B_Line&, T2Col$))
  Else
   Set TRange = .Range(.Cells(StaRow&, T1Col$), .Cells(EndRow&, T2Col$))
  End If
 End With
 TRange.Copy Destination:=P_Sheet.Cells(PasRow&, P1Col$)
      
 Set T_Sheet = Nothing
 Set P_Sheet = Nothing
 Set TRange = Nothing
End Sub

0 hits

【43785】複雑な(?)転記 更夜 06/10/25(水) 17:33 質問
【43786】Re:複雑な(?)転記 ゆと 06/10/25(水) 18:09 発言
【43788】Re:複雑な(?)転記 ゆと 06/10/25(水) 19:05 発言
【43818】Re:複雑な(?)転記 更夜 06/10/26(木) 11:48 発言
【43848】Re:複雑な(?)転記 Hirofumi 06/10/26(木) 20:22 回答
【43945】Re:複雑な(?)転記 更夜 06/10/30(月) 15:20 お礼

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