Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


50129 / 76732 ←次へ | 前へ→

【31499】Re:削除
回答  Hirofumi  - 05/11/23(水) 14:02 -

引用なし
パスワード
   こんななのかなあ?
Option Explicit

Public Sub RowsDelete()

  Dim i As Long
  Dim lngRows As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim strProm As String

'  Application.ScreenUpdating = False
  
  'データの左上隅を基準とする(列見出しが有る物とします)
  Set rngList = ActiveSheet.Cells(1, "A")
  With rngList
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    If lngRows <= 1 And .Value = "" Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '削除フラグの列をKeyとして整列
    .Offset(1).Resize(lngRows, 2).Sort _
          Key1:=.Offset(, 1), Order1:=xlAscending, _
          Header:=xlNo, OrderCustom:=1, _
          MatchCase:=False, Orientation:=xlTopToBottom, _
          SortMethod:=xlStroke
    'B列データを配列に取得
    vntData = .Offset(1, 1).Resize(lngRows).Value
  End With
    
  'データ行数分繰り返し
  For i = 1 To lngRows
    'FalseからTrueに変わる位置を取得
    If vntData(i, 1) Then
      lngCount = i
      Exit For
    End If
  Next i
  Erase vntData
  
  With rngList
    '行削除
    .Offset(lngCount).Resize(lngRows - lngCount + 1).EntireRow.Delete
  End With
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

0 hits

【31493】削除 yukko 05/11/23(水) 13:01 質問
【31494】Re:特定の値を削除 かみちゃん 05/11/23(水) 13:24 発言
【31495】Re:削除 ちくたく 05/11/23(水) 13:27 回答
【31496】Re:削除 かみちゃん 05/11/23(水) 13:32 発言
【31497】Re:削除 ちくたく 05/11/23(水) 13:59 発言
【31498】Re:削除 Kein 05/11/23(水) 14:02 回答
【31499】Re:削除 Hirofumi 05/11/23(水) 14:02 回答
【31500】Re:削除 yukko 05/11/23(水) 16:43 お礼

50129 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free