[[20190117185856]]　『VBAでのコピーアンドペーストのエラー』（もりりん）　ページの最後に飛ぶ

『VBAでのコピーアンドペーストのエラー』（もりりん）

当方初心者でして、コピーアンドペーストで躓いております、宜しくお願いします

Sub seiretu()

Dim col '列数カウンタ
Dim row '行数カウンタ
Dim ncol '次の列数カウンタ
Dim nrow '次の行数カウンタ
Dim gen 'ループ数

    Sheets("行集計").Select
    Set gen = Range("B2")
    Sheets("行整列").Select
    Range("A2").Select 'A2セルを初期位置に設定
    col = 0
    row = 0
    nrow = 0

    Do While gen >= col
        If ActiveCell = "" Then
            ActiveCell.Offset(-row, 1).Select
            col = col + 1
            nrow = row
            row = 0
        Else
            Selection.Copy
            ActiveCell.Offset(nrow, 21 - col).Select
       1→  Selection.Paste
            ActiveCell.Offset(1 - nrow, -21 + col).Select
            row = row + 1
        End If
    Loop

End Sub

複数の列の一定数でない内容を一列にまとめるというような内容でマクロを組んでみたところ1のところで
実行時エラー'438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
と表示されます
見苦しいとは思いますが宜しくお願い致します

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 どういうデータかわかりませんが、
 　SelectやActiveはやめましょう！
 　型宣言はちゃんとしておきましょう！
 なんとなくやりたいことはこうかしら？というものを書き直したのでいかがです？
 それでもちょっとわかりにくいので、実データもらえると助かります。

    Sub seiretu()
        Dim col As Long '列数カウンタ
        Dim row As Long '行数カウンタ
        Dim ncol As Long '次の列数カウンタ
        Dim nrow As Long '次の行数カウンタ
        Dim gen As Long 'ループ数
        Dim r   As Range
        gen = Sheets("行集計").Range("B2").Value
        Set r = Sheets("行整列").Range("A2")  'A2セルを初期位置に設定
        col = 0
        row = 0
        nrow = 0

        Do While gen >= col
            If r.Value = "" Then
                Set r = r.Offset(-row, 1)
                col = col + 1
                nrow = row
                row = 0
            Else
                r.Offset(nrow, 21 - col).Value = r.Value
                Set r = r.Offset(1 - nrow, -21 + col)
                row = row + 1
            End If
        Loop
    End Sub

（稲葉） 2019/01/17(木) 19:34

すみません、独学でマクロの記録を参考に組んでいた為
基本がなってませんでした、お目汚し申し訳ありません

済みません見直したところB2の指定は間違いでB1でした
稲葉様の書き直して頂いたものでデバッグを行うと
Set r = r.Offset(1 - nrow, -21 + col)
この一節で
実行時エラー'1004'
アプリケーション定義またはオブジェクト定義エラーですとなりました
各変数に入るのは基本が数字になりますが
変数rに格納するのは文字列になります
そのせいなのかはわかりませんが参考になればと思います

実データをお渡ししたいとは思うのですが
データ添付がわからず申し訳ありません
（もりりん） 2019/01/18(金) 09:26

横からですが気になったので投稿します。

＞変数rに格納するのは文字列になります
いえ、変数に格納される（されている）のはセル（範囲）というオブジェクトです。

コレを踏まえると

＞Set r = r.Offset(1 - nrow, -21 + col)
＞この一節で
＞実行時エラー'1004
＞アプリケーション定義またはオブジェクト定義エラーですとなりました
↑は、Offsetした結果、あり得ないセルを指定してしまったため、エラーになったものと思われます。

 例: rに格納されているのがA2セルの場合
 r.Offset(-1,0).Address(0,0)　→　A2セルの一つ上のA1セルのアドレスが返され成功
 r.Offset(0,-1).Address(0,0)  →　A列より左にセルが無いのでエラー発生

なので、ローカルウィンドウやイミディエイトウィンドウを使って「r」「nrow」「col」にそれぞれ何が格納されているか確認してみてください。

また、私見になりますが、ファイルをどこかにアップロードしてリンクを張るのは規約上NGではないようですけど、セキュリティの観点から見ないという方針の回答者さんも一定数おられるようにおもいますので、なるべくなら頑張って文字で再現されたほうがよいとおもいます。

その場合、各行の先頭に半角スペースを入れると、上記の「例」部分のようにちょっと小さめの文字で改行されずに表示されるようになります。

（もこな２） 2019/01/18(金) 12:36

稲葉様、もこな２様
大変ありがとうございました！
解決する事が出来ました！！
稲葉様は私のつたない構文を校正していただき大変ありがとうございました！
もこな２様はエラーに対する的確なご指示を有難うございます！
r.Offset(nrow, 21 - col).Value = r.Value
でrに格納されているセルが移動したと勘違いしてました。
Set r = r.Offset(1 - nrow, -21 + col)
で移動したセルを目的のセルに移動しようとして
存在しないセルを指定していることでエラーが出ていました。
最終的に細かいところを修正して完成に至りました！有難うございました。

Sub seiretu()

        Dim col As Long '列数カウンタ
        Dim row As Long '行数カウンタ
        Dim nrow As Long '次の行数カウンタ
        Dim gen As Long 'ループ数
        Dim r   As Range
        gen = Sheets("行集計").Range("B1").Value
        Set r = Sheets("行整列").Range("A2")  'A2セルを初期位置に設定
        col = 0
        row = 0
        nrow = 0
        Do While gen >= col
            If r.Value = "" Then
                Set r = r.Offset(-row, 1)
                col = col + 1
                nrow = nrow + row
                row = 0
            Else
                r.Offset(nrow, 26 - col).Value = r.Value
                Set r = r.Offset(1, 0)
                row = row + 1
            End If
        Loop
    End Sub

（もりりん） 2019/01/18(金) 13:58

コメント返信：

[ 一覧(最新更新順) ]

[[20190117185856]] 『VBAでのコピーアンドペーストのエラー』（もりりん） ページの最後に飛ぶ

[[20190117185856]]　『VBAでのコピーアンドペーストのエラー』（もりりん）　ページの最後に飛ぶ