[[20210914114023]] 『別のシートにコピペ、指定したものだけ』(たなか) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『別のシートにコピペ、指定したものだけ』(たなか)

いつもお世話になっております。

sheet1のA列に「1」が入っている行だけ、sheet2にコピペするのですが、
下図のように貼り付けたいです。

[sheet1]
  A列  B列   C列  D列
1行 1  コードあ 品名あ 数量あ
2行    コードい 品名い 数量い
3行 1  コードう 品名う 数量う
4行 1  コードえ 品名え 数量え
5行    コードお 品名お 数量お

[sheet2]
  A列   B列   C列  D列
1行 コードあ コードう コードえ
2行 品名あ 品名う 品名え
3行 数量あ 数量う 数量え

で、コードを並べてみたのですが、「オブジェクトが必要です」と
エラーが出ます。
どうすれば実行できるでしょうか。
よろしくお願いします。

Sub コピペ()

   For i = 1 To 10

    If Worksheets("sheet1").Cells(i, 1) = "1" Then

      With Worksheets("sheet2").Cells(1, 1).End(xlToRight).Column
        .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2)
        .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3)
        .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4)
      End With

    End If

  Next i

End Sub

< 使用 Excel:Excel2019、使用 OS:Windows10 >


Dim i As Long, Colct As Long
i = 1
Do
   If Sheets("Sheet1").Cells(i, 1).Value = 1 Then
      Colct = Colct + 1
      Sheets("Sheet2").Cells(1, Colct).Resize(3, 1).Value = WorksheetFunction.Transpose(Sheets("Sheet1").Cells(i, 2).Resize(, 3).Value)
   End If
   i = i + 1
Loop Until Sheets("Sheet1").Cells(i, 2).Value = ""
(mihon) 2021/09/14(火) 14:35

■1
>Worksheets("sheet2").Cells(1, 1).End(xlToRight).Column
↑だと返ってくるのは、sheet2のA1セルから右に見ていき、はじめにデータが無くなるセルの【列番号】
したがって、(セルなどの)【オブジェクト】ではない
にも関わらず、「.Offset(0, 1)」なんてしようとするから「オブジェクトが必要です」となる。

■2
よって、単純に直すなら「.Column」を取ればよいが

    Sub コピペ修正()
        Dim i As Long

        For i = 1 To 10
            If Worksheets("sheet1").Cells(i, 1) = "1" Then
                With Worksheets("sheet2").Cells(1, 1).End(xlToRight)
                    .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2)
                    .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3)
                    .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4)
                End With
            End If
        Next i
    End Sub

場合によっては↓が問題を引き起こすことになる

 Worksheets("sheet2").Cells(1, 1).End(xlToRight)

先に「sheet2のA1セルから右に見ていき」と述べたが、実際にはsheet2の1行目が空っぽの場合や、A1セルのみにデータが入っている場合残念なことになる。(実験してみればわかるはず)

■3
よって、普通は、【最大列から左】に見ていき見つかったセルという指定をするアプローチがよく採られます。

    Sub コピペ修正_改()
        Dim i As Long

        For i = 1 To 10
            If Worksheets("sheet1").Cells(i, 1) = "1" Then
                With Worksheets("sheet2").Cells(1, Columns.Count).End(xlToLeft)
                    .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2)
                    .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3)
                    .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4)
                End With
            End If
        Next i
    End Sub

これで大体の問題が解決するが、sheet2がまっさらだった場合にはB列から始まってしまうという問題が残ります。

■4
↑の問題は、1列目(というか、A1セル)にデータがあるかどうかで判定するという手が使えます。
さらに、1セルずつ転記をせずともプロシージャ名どおり、【コピペ】でも対応。

    Sub 研究用()
        Dim i As Long
        Dim 出力セル As Range

        Stop 'ブレークポイントの代わり

        Set 出力セル = Worksheets("sheet2").Cells(1, Columns.Count).End(xlToLeft)
        If 出力セル.Value <> "" Then Set 出力セル = 出力セル.Offset(0, 1)

        With Worksheets("sheet1")
            For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(i, 1) = "1" Then
                    .Cells(i, "B").Resize(1, 3).Copy
                    出力セル.PasteSpecial Transpose:=True
                    Set 出力セル = 出力セル.Offset(0, 1)
                End If
            Next i
        End With

    End Sub

■5
最後に、ネット検索で見かけたコードや質問掲示板で回答のあったコードは闇雲に実行するのではなく、きちんとステップ実行しつつ、判らない部分はしらべたり聞いたりしてちゃんと理解することをお勧めします。
(でないと、今回のようなミスに自分で気付けなくなってしまうので)

(もこな2) 2021/09/14(火) 15:04


mihonさん、もこな2さん、ありがとうございました!
解決しました!
(たなか) 2021/09/14(火) 16:14

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.