Excel (VBA)

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

 
(Windows 7 Home Premium : Excel 2007)
切り取った行の跡を詰めたい
投稿日時: 18/09/12 16:26:53
投稿者: kkkk

「切り取った行の跡を詰めたい」
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1165727676
ベストアンサーに選ばれたコードを参考に特定の行を切り取って別シートに貼り付ける。
そこまではうまく行きましたが、切り取った部分が空白のままになっています。
上へ詰めたいのです。
検索しましたところ、
https://h1r0-style.net/excelvba/howto-delete-rows-with-blank
これが見つかりました。下記にコードを記述しました。
結果、ループのまま?か、なかなか終わりません。強制的に終了しました。
どこが間違っておりますか?
宜しくおねがいします。
 
Sub hassozumi()
Dim i, LastRow As Long
LastRow = Cells(Rows.Count, 9).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 9) = "発送済み" Then
Rows(i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i
 
' 空白行を削除
Dim GYO As Long
  Dim KuhakuGyo As Range
  Dim r As Long
 
   ' A列をみて表の最終行を取得する ------ ※1
  GYO = Cells (Rows.Count, 1).End (xlUp).Row
  '2行目から最終行までB列のセルをチェックします
  With ActiveSheet
    For r = 2 To GYO
    'B列のセルが空白なら変数 KuhakuGyo に追加
    If IsEmpty(Cells(r, 2).Value) Then
      '最初の空白行に出会ったら行全体を KuhakuGyo にセット
      If KuhakuGyo Is Nothing Then
        Set KuhakuGyo = .Rows(r).EntireRow
      '2件目からは順次 KuhakuGyo に追加していく
      Else
        Set KuhakuGyo = Union(KuhakuGyo, .Rows(r).EntireRow)
      End If
    End If
    Next r
  End With
 
  '空白行があれば一括で削除する
  If Not KuhakuGyo Is Nothing Then
    KuhakuGyo.Delete
  End If
 
End Sub

回答
投稿日時: 18/09/12 17:34:08
投稿者: WinArrow
投稿者のウェブサイトに移動

>切り取った部分が空白のままになっています。
 
コードのどこで「切り取って」いますか?
空白になっていることをどのように確認していますか?

回答
投稿日時: 18/09/12 17:38:49
投稿者: Suzu

引用:
特定の行を切り取って別シートに貼り付ける。

引用:
Rows(i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

  
ご提示のコードは
マクロ実行時にアクティブとなっているシートのi 行目 を Sheet2 の 最終行に『コピー』しています。
  
なので
引用:
切り取った部分が空白のままになっています

空白になるはずがないです。
本当に、提示頂いたコードを実行した上での話でしょうか。
 
 
仮に、本当に切り取りをしたいのであれば
「切り取った行の跡を詰めたい」
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1165727676
の中で、Cut と初めから言っています。
それなのに なぜ Copyなのですか?
 
 
なかなか終わらないとの事ですが、データは何行何列あるのですか?

投稿日時: 18/09/12 17:48:39
投稿者: kkkk

あ、すみません。
書き直すの忘れてました。
Rows(i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Rows(i).Cut Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
です。
なので切り取った部分が空白のままになっています。

回答
投稿日時: 18/09/12 17:53:08
投稿者: WinArrow
投稿者のウェブサイトに移動

注意事項
 
(1)データ型について
>Dim i, LastRow As Long
変数「i」と「LastRow」の両方を「Long」で定義したつもりでしょうか?
Dim i As Long, LastRow As Long
と記述しないと、「i」は、Variantになっています。
 
(2)処理対象のシートの指定
セルをシートで修飾しないと、アクティブシートになってしまいます。
複写元シートが「Sheet1」だったら、
@方法1
 Sheets("Sheet1").Activate
A方法2
  Sheets("Sheet1").Cells(i, 9)
B方法3
 With Sheets("Sheet1")
  を記述し
  .Cells(i, 9)
いづれかの方法で記述したほうが安全です。

投稿日時: 18/09/12 17:53:53
投稿者: kkkk

なかなか終わらないとの事ですが、データは何行何列あるのですか?

1万行以上あります。
試しに少なくしてみましたところ、正常に動作しました。
お騒がせしました。