Excel (VBA)

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

 
(Windows 10 Home : Excel 2013)
シート間で転記するマクロが動かず困っています
投稿日時: 18/03/18 14:13:50
投稿者: kakijp

AAシートのA4:I100のセル範囲からJJシートのA列からI列迄必要な行だけを1行づつ転記したくて次のマクロを作りました。
r = Range(Cells(i, 12)).Valueで停止してしまいます。
いくら考えても分からないため、どうか教えて頂きたく宜しくお願いします。
 
Sub AAシートからJJシートに転記()
Dim i As Integer
Dim r As Integer
 
 For i = 4 To 35 'L 列に記載している転記したい行番号
   r = 0
   r = Range(Cells(i, 12)).Value 'L 列にAAシートにある35個のデータ行
   Sheets("AA").Range("A" & r & ":I" & r).Copy _
    Destination:=Sheets("JJ").Range("A" & r)
 Next i
 
Application.CutCopyMode = False
End Sub

回答
投稿日時: 18/03/18 14:49:50
投稿者: WinArrow
投稿者のウェブサイトに移動

>   r = Range(Cells(i, 12)).Value 'L 列にAAシートにある35個のデータ行
 問題のコードには、2つの問題点があります。
  
1つ目、
セルをシートで修飾しましょう。
シートで修飾してないと、その時点のアクティブシートになってしまうので
指定のセルに意図した「値」が入っていないことがあります。
  
2つ目
>Range(Cells(i, 12)).Value
実行時エラー 1004
エラーメッセージも掲示しましょうね・・・・
  
この記述は、単独セルでもセル範囲とみなされます。
 
以上のことから修正案
 r = Sheets("AA").Cells(i, 12).Value
または
 r = Sheets("AA").Cells(i, "L").Value
   
後者をお勧めします。
  
なお
 r = 0
は不要ですね・・・
  
  

回答
投稿日時: 18/03/18 15:40:48
投稿者: WinArrow
投稿者のウェブサイトに移動

説明が間違っているため、訂正します
 
>この記述は、単独セルでもセル範囲とみなされます。

この記述は、下のように解釈されます。
 
   r = Range(Cells(i, 12).Value).Value
L列セルの値のセルの値を変数「r」に代入
 
L列セルの値は、数値が入っていますよね・・・
たとえば「10」
10というセルは存在しないから
実行時エラー1004
が表示されました。
 
仮に、L列セルの「値」が、「H1」だったら、セルH1の値が変数「r」に代入されます。

投稿日時: 18/03/18 15:41:04
投稿者: kakijp

WinArrow さま
 早速ありがとうございます。
 r = 0は削除しました。
 'L 列にAAシートにある35個のデータ行 記載しましたのは
   JJ シートに作成した行ですので r = Sheets("AA").Cells(i, "L").Value の
   AA は JJ になりますが、 r = Sheets("JJ").Cells(i, "L").Value にすると この行で
   停止してしまいました。
 
    r = Sheets("AA").Cells(i, "L").Value にすると次の2行の箇所で停止しました。
      Sheets("AA").Range("A" & r & ":I" & r).Copy _
       Destination:=Sheets("JJ").Range("A" & r)
 
 どうしてでしょうか。
 申し訳ありませんが、よろしくお願いします。
 
   
 

投稿日時: 18/03/18 15:44:09
投稿者: kakijp

WinArrow さま
 ありがとうございます。
 L列のセルには行番号だけが縦に35行に渡って記載してあります。
 よろしくお願いします。

回答
投稿日時: 18/03/18 15:47:19
投稿者: WinArrow
投稿者のウェブサイトに移動

>停止しました
だけでは、状況が分かりません。
 
↓2つのことを確認してください。
(1)どのようなエラーメッセージが出ていますか?
(2)停止した時の「r」の値は?

回答
投稿日時: 18/03/18 15:56:39
投稿者: WinArrow
投稿者のウェブサイトに移動

> r = Sheets("JJ").Cells(i, "L").Value
この行で停止している場合、「r」の値ではなく
セルの値を確認しましょう。
 

投稿日時: 18/03/18 16:09:17
投稿者: kakijp

WinArrow さま
 
申し訳ありませんでした。
エラーの状況は次の通りでした。
よろしくお願いします。
 
JJにした時は
 r = Sheets("JJ").Cells(i, "L").Value 
 r = Sheets("JJ").Cells(i, "L").Value 行が黄色で塗られます。
 実行時エラー'9':
 インデックスが有効範囲にありません。
 i の値は4です。
 r の値はゼロ(0)です。
 
AAにした時は
 r = Sheets("AA").Cells(i, "L").Value
 次の2行が黄色で塗られて停止しました。
       Sheets("AA").Range("A" & r & ":I" & r).Copy _
        Destination:=Sheets("JJ").Range("A" & r)
  JJの時と同様のエラーです。
 i の値は4です。
 r の値はゼロ(0)です。

回答
投稿日時: 18/03/18 16:44:54
投稿者: WinArrow
投稿者のウェブサイトに移動

kakijp さんの引用:
WinArrow さま
 
申し訳ありませんでした。
エラーの状況は次の通りでした。
よろしくお願いします。
 
JJにした時は
 r = Sheets("JJ").Cells(i, "L").Value 
 r = Sheets("JJ").Cells(i, "L").Value 行が黄色で塗られます。
 実行時エラー'9':
 インデックスが有効範囲にありません。
 i の値は4です。
 r の値はゼロ(0)です。

この時、考えられるのは、シート名が正しくないと思います。
 
次のコードを r = Sheets("JJ").Cells(i, "L").Value の前に挿入し
確認してみましょう
Dim Sht as worksheet
For Each sht In Sheets
    Debug.Print "XX" & sht.Name & "xx"
Next
 
 
 
 
 
 
 
AAにした時は
は、実際には、使わないので、考えなくてもよいでしょう。
 
 
 

投稿日時: 18/03/18 17:51:41
投稿者: kakijp

WinArrow さま
 お手数をお掛けしており申し訳ありません。
 
 原因は不明ですが、転記されるようになりましたが
 L 列に表示した行番号が連続していないので転記されても空白行ができます。
 空白行を空けずに連続して転記できればと思いますので、その場合は
 どのようにすればいいでしょうか。
 申し訳ございませんが、追加して教えて頂ければと思います。
 
 勝手ばかり言って本当に申し訳ありませんが、よろしくお願いします。

回答
投稿日時: 18/03/18 18:11:39
投稿者: WinArrow
投稿者のウェブサイトに移動

kakijp さんの引用:
 原因は不明ですが、転記されるようになりましたが
 L 列に表示した行番号が連続していないので転記されても空白行ができます。
 空白行を空けずに連続して転記できればと思いますので、その場合は
 どのようにすればいいでしょうか。

 
こちらでは、あなたのPCの画面は見えませんから
対処方法は、分かりません。
 
L列のデータは、実際にどのようになっているのですか?

回答
投稿日時: 18/03/18 19:09:11
投稿者: 半平太

>'L 列にAAシートにある35個のデータ行
 
35個ですよね?
なのに、これだと4から35迄だから32個ですよ? どっちが正しいんですか?
     ↓
>For i = 4 To 35 'L 列に記載している転記したい行番号
 
32個が正しければ

Sub AAシートからJJシートに転記()
    Dim i As Integer
    Dim RwRead As Integer
    Dim RwWrite As Integer
    
    RwWrite = 4
    For i = 4 To 35  'L 列に記載している転記したい行番号
        RwRead = Sheets("JJ").Cells(i, 12).Value
        
        If 4 <= RwRead And RwRead <= 100 Then
            Sheets("AA").Range("A" & RwRead & ":I" & RwRead).Copy _
                Destination:=Sheets("JJ").Range("A" & RwWrite)
            RwWrite = RwWrite + 1
        End If
    Next i
    
    Application.CutCopyMode = False
End Sub

投稿日時: 18/03/18 19:24:54
投稿者: kakijp

WinArrowさま
色々ありがとうございます。
L列のデータは下のようになっています。
4から35まで32ですが、個数は変動します。
  L M
行No L列の値です
4  4
5  5
6  7
7  9
8  10
9  11
10 12
11 15
 
半平太 さま
ありがとうございます。
ご返事のコードでトライさせてください。
WinArrowさまの返信で最初の諮問は解決しましたが、
現在飛び行がれば転記時に空行ができるので
それを解決したく回答しているところです。

投稿日時: 18/03/18 19:37:28
投稿者: kakijp

半平太 さま
 ありがとうございます。
 データ数を増やして実行してみました。
 空行もなくなりましたので、満足です。
 また、よろしくお願いいたします。

投稿日時: 18/03/19 11:41:47
投稿者: kakijp

WinArrowさま
半平太 さま
 
色々ありがとうございました。
無事に解決することができました。