Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
別シートへ自動で張り付けしたい
投稿日時: 18/05/15 16:50:21
投稿者: SHIBARAKU

いつもお世話になっています。
 
以下のようなシート1、2、3がありまして、
シート1には対象の年月を入力します。
シート2には1月から12月までの金額を事前に入力し、
シート3で対象年月の実績を作成します。
そこで、シート2に入力している対象年月をコピーしてシート3へ自動で張り付けたいのですが、
マクロを実行してもコピーされない状態になってしまいます。
コードは以下にありますが、この記述ですとセル指定はできないようで、解決策があるとすれば、
お教えください。
 
◎シート1  対象の年月を入力します
 
作成年月    2018    年    10    月
 
 
◎シート2  1から12まで列に金額が入力されています。
 
    1        2        3    ・・・・・・・・・・
属性    金額(計画)    金額(計画)    金額(計画)
A    500,000        50     0                        
B    600,000        350     20                        
C    500,000        15     3                        
D    0        0     0                        
E    700,000        100     2                        
F    0        0     0                        
G    0        0     0                        
H    0        0     0                        
I    300,000        30     3                        
J    0        0     0                        
K    0        0     0                        
L    0        0     0                        
M    0        0     0                        
N    0        0     0                        
S    0        0     0                        
U    0        0     0                        
T    13,000        40     3                        
Z    48,000        5     0                        
 
 
◎シート3  対象月の実績表を作成します
 
2018年10月実績
                    
属性        金額(実績) 金額(計画)    
A     517,100        500,000                             
B     700,870        600,000                             
C     550,000        500,000                         
D     0        0                             
E     730,553        700,000                             
F     0        0                             
G     0        0                             
H     0        0                             
I     350,000        300,000                             
J     0        0                             
K     0        0                             
L     0        0                             
M     0        0                             
N     0        0                             
S     0        0                             
U     0        0                             
T     10,158        43,000                             
Z     45,565        48,000                 
合計        2,904,246    2,691,000
    
 
◎コード
 
Sub 計画セット()
'-------変数の設定-------
    Dim tuki As Variant
    Dim retu As Variant
    Dim fukusha As Variant
    Dim cnt As Variant
'
'+++++対象月セット
    tuki = Workbooks("excel.xlsm").Sheets("シート1").Range("E4").Value
'
'+++++計画セット
  For cnt = 1 To 12
'
     If cnt = 1 Then '----------1月
          retu = "B5"
          fukusha = "B7:B26"
     End If
'
     If cnt = 2 Then '----------2月
          retu = "C5"
          fukusha = "C7:C26"
     End If
'
     If cnt = 3 Then '----------3月
          retu = "D5"
          fukusha = "D7:D26"
     End If
'
     If cnt = 4 Then '----------4月
          retu = "E5"
          fukusha = "E7:E26"
     End If
'
     If cnt = 5 Then '----------5月
          retu = "F5"
          fukusha = "F7:F26"
     End If
'
     If cnt = 6 Then '----------6月
          retu = "G"
          fukusha = "G7:G26"
     End If
'
     If cnt = 7 Then '----------7月
          retu = "H5"
          fukusha = "H7:H26"
     End If
'
     If cnt = 8 Then '----------8月
          retu = "I5"
          fukusha = "I7:I26"
     End If
'
     If cnt = 9 Then '----------9月
          retu = "J5"
          fukusha = "J7:J26"
     End If
'
     If cnt = 10 Then '---------10月
          retu = "K5"
          fukusha = "K7:K26"
     End If
'
     If cnt = 11 Then '---------11月
          retu = "L5"
          fukusha = "L7:L26"
     End If
'
     If cnt = 12 Then '---------12月
          retu = "M5"
          fukusha = "M7:M26"
     End If
'
     Sheets("シート2").Select
'
     If tuki = Range(retu).Select Then
         Range(fukusha).Select
         Selection.Copy
         Sheets("シート3").Select
         Range("C4").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
     End If
'
  Next cnt
'
End Sub
 

回答
投稿日時: 18/05/15 18:32:43
投稿者: mattuwan44

入力された月で、列の位置が解るから、
変なループとかしなくてもいいかと。
 
 
Sub 計画セット()
    '-------変数の設定-------
    Dim tuki As Long
    '
    '+++++対象月セット
    tuki = Workbooks("excel.xlsm").Sheets("シート1").Range("E4").Value
    '
    '+++++計画セット
    With Workbooks("excel.xlsm").Sheets("シート2").Range("A1").CurrentRegion
        Intersect(.Cells, .Offset(1).Columns(tuki + 1)).Copy
    End With
    Sheets("シート3").Range("C4").PasteSpecial Paste:=xlPasteValues
End Sub

回答
投稿日時: 18/05/15 18:52:29
投稿者: WinArrow
投稿者のウェブサイトに移動

> If tuki = Range(retu).Select Then
こんな命令はありません。
 
 
結果的に、指定の月のみを複写すればよいので
1〜12のループは不要です。
指定月に対応する「列」が求めるように
単純化できませんか?
 
1月がC列・・・つまり、列番号で3ですから
指定月に+2が対象の列になります。
 
セルを指定するのに
Range("C3")
は、
そのまま「C3」セルですが
Cells(行,列)
と数字で指定できます
 
Cells(3,指定月+2)
とすることができます。
 
Tukiを求めた後は
次の2行で済むはず
 
    Worksheets("シート3").Range("C4").Resize(20).Value = _
        WorkSheets("シート2").Cells(7, tuki + 2).Resize(20).Value
 

回答
投稿日時: 18/05/15 19:14:44
投稿者: もこな2

前提の表がよく理解できなかったですし、ループさせている理由がわからないんですけど、結局
 (1)シート1のE4セルの値を参照して、
 (2)シート2のどの範囲をコピーするか決めて
 (3)シート3のC4に貼り付けたい
ってことではないかとおもうんですが如何でしょうか?
 
とりあえず、提示のコードを上記の推測で直してみるとこんな感じになりました。
 

Sub test1()
    Dim srcRNG As Range
    Dim MyBOOK As Workbook
        Set MyBOOK = Workbooks("excel.xlsm")

    With MyBOOK.Sheets("シート2")
        Select Case MyBOOK.Worksheets("シート1").Range("E4").Value
            Case Is = 1: Set srcRNG = .Range("B7:B26")
            Case Is = 2: Set srcRNG = .Range("C7:C26")
            Case Is = 3: Set srcRNG = .Range("D7:D26")
            Case Is = 4: Set srcRNG = .Range("E7:E26")
            Case Is = 5: Set srcRNG = .Range("F7:F26")
            Case Is = 6: Set srcRNG = .Range("G7:G26")
            Case Is = 7: Set srcRNG = .Range("H7:H26")
            Case Is = 8: Set srcRNG = .Range("I7:I26")
            Case Is = 9: Set srcRNG = .Range("J7:J26")
            Case Is = 10: Set srcRNG = .Range("K7:K26")
            Case Is = 11: Set srcRNG = .Range("L7:L26")
            Case Is = 12: Set srcRNG = .Range("M7:M26")

            Case Else
                MsgBox "シート1の「E4」セルは1〜12の数値を入力してください"
                Exit Sub
        End Select
    End With

    srcRNG.Copy
    MyBOOK.Sheets("シート3").Range("C4").PasteSpecial Paste:=xlPasteValues

End Sub

 
お悩みのポイントはコピーの対象となるセル範囲を文字列で一度取得してから何とかしようとしてうまくいかなかったんだとおもいますが、そうであれば、文字列じゃなくてセル範囲そのものとして扱ってしまえばわかりやすいんじゃないかと思います。
 
VBAの世界では、セル(範囲)やシート、ブックなんかはオブジェクトと呼ばれ、これらを格納する変数は、オブジェクト型変数なんて言われます。
オブジェクト変数に値を格納する場合は、普通の変数と違って 原則【Set 変数名 = 「格納したいオブジェクト」】のように記述します。
 
私も説明が上手でないので、「VBA オブジェクト型変数」なんてキーワードで調べてみるとわかりやすいサイトが見つかるんじゃないかな〜と思いますので詳しい説明は割愛しますが、まずはオブジェクト型変数の利用を検討してみるといいとおもいます。
 
つぎに、先述のようにループさせている理由はわかりませんが、貼付先が1つしかないので、単純に「tuki」に格納されている値によって処理分岐したいだけじゃないかなと推測しました。
このように、一つの条件で複数に分岐するには「Select Case」がオススメです。
(IF〜ElseIF〜ElseIf〜・・・End IF という手も使えなくはないですが。。。)
 
これを踏まえて修正したものがtest1です。
 
長くなったので、次投稿に続きます。

回答
投稿日時: 18/05/15 20:35:53
投稿者: WinArrow
投稿者のウェブサイトに移動

読みか違いしていました
 
>1月がC列・・・つまり、列番号で3ですから
>指定月に+2が対象の列になります。
 ↓
 
1月がB列・・・つまり、列番号で2ですから
指定月に+1が対象の列になります。
  
従って
    Worksheets("シート3").Range("C4").Resize(20).Value = _
         WorkSheets("シート2").Cells(7, tuki + 1).Resize(20).Value
  
となります。
 
※ Resize(20)は、7行目〜26行目の20行です。
 
いろいろな記述方法
 
    With Worksheets("シート2").Range("A7:A26")
        Worksheeets("シート3").Range("C4").Resize(.Rows.Count).Value = .Offset(,tuki).Value
    End With
 
 
 
        

回答
投稿日時: 18/05/15 22:32:41
投稿者: もこな2

前の投稿から続く。(他の回答者さんの内容とかなりかぶってますがとりあえず。)
 
例えば「1月」のコピー元となるのはシート2の"B7:B26"ですよね。
これをVBA語に直すと、
Sheets("シート2").Range("B7:B26")
と、ここまでは理解されているとおもいます。
実は、他にも表現の仕方があって

Sheets("シート2").Range(Sheets("シート2").Range("B7"),Sheets("シート2").Range("B26"))
Sheets("シート2").Range(Sheets("シート2").Cells(7,2),Sheets("シート2").Cells(26,2))
のように、範囲の始まりと終わりを指定してあげると、Excel君がその2セルで囲まれた範囲が指定されているんだなと理解してくれます。
 
ちなみに、この記述方法をするときは、シート1の中にある(シート2のA1、シート3のB5)みたいに辻褄が合わない記述をすると、エラーとなってしまうので注意してください
 
そして↑でしれっと使ってしまいましたが、単一のセルを表現するのにRangeプロパティを使ってセルの番地を文字列で表現する方法もあるのですが、Cellsプロパティというものを使って行番号と列番号で表現する方法もあります。
 
それを使うと、シート2の「B7:B26」は、シート2の中にある「(7行目、2列目)のセル」〜「(26行目、2列目)のセル」という表現も可能ということになります。
 
さて、勘が冴えていればピンとくるかもしれませんが、上記の方法を使えば列を"数字"で表現できることになります。
そして、今回「tuki」に入るのも1〜12の"数字"です。
 
もっとわかりやすくすると
 1(月)・・・・B列 → 2列目
 2(月)・・・・C列 → 3列目
 3(月)・・・・D列 → 4列目
というようになっているわけですから、月に1を足せば何列目なのかという"数字"が導きだせるということになります。
 
そうなると、紹介しておいてなんですが条件分岐なんかしなくても、対象となる列の数字が導き出せるということがお分かりになるかと思います。
 
というもろもろを踏まえると、他の回答者さんと似たようなものになってしまいますが、↓のようなコードでもいいんじゃないかとおもいます。
Sub test2()
    Dim srcRNG As Range
    Dim MyBOOK As Workbook: Set MyBOOK = Workbooks("excel.xlsm")
    Dim 月 As Variant

    月 = MyBOOK.Worksheets("シート1").Range("E4").Value

    'シート1の「E4」に1〜12の数値が入力されているのか判定
    If 月 = Int(月) And IsNumeric(月) And 月 >= 1 And 月 <= 12 Then
        With MyBOOK.Sheets("シート2")
            Set srcRNG = .Range(.Cells(7, 月 + 1), .Cells(26, 月 + 1))
        End With
    Else
        MsgBox "シート1の「E4」セルは1〜12の数値を入力してください"
    End If

    'PasteSpecialで値だけコピーするという手以外に、Valueプロパティを参照するという手もある
    With srcRNG
        MyBOOK.Sheets("シート3").Range("C4").Resize(.Rows.cout, Columns.Count).Value = .Value
    End With

End Sub

投稿日時: 18/05/16 09:33:45
投稿者: SHIBARAKU

みなさん詳しくご説明頂きありがとうございます。
もこな2さんの方法で行い、動作しました。