Excel VBA質問箱 IV

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

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


4089 / 13644 ツリー ←次へ | 前へ→

【58476】条件に当てはまる行を削除 すー 08/10/27(月) 17:19 質問[未読]
【58477】Re:条件に当てはまる行を削除 こぎつね 08/10/27(月) 17:50 発言[未読]
【58480】Re:条件に当てはまる行を削除 Hirofumi 08/10/27(月) 19:17 発言[未読]
【58487】Re:条件に当てはまる行を削除 Hirofumi 08/10/27(月) 21:48 発言[未読]
【58485】Re:条件に当てはまる行を削除 ponpon 08/10/27(月) 20:42 発言[未読]
【58500】Re:条件に当てはまる行を削除 すー 08/10/28(火) 15:02 お礼[未読]

【58476】条件に当てはまる行を削除
質問  すー  - 08/10/27(月) 17:19 -

引用なし
パスワード
   最近VBAを始めた初心者ですが、どうか皆さん力を貸して下さい。

エクセルで、A列のセルに数値以外のものが入ってる時、その行を削除(上にスクロール)できる様なマクロを作成しましたが、どうも上手く動作しません。エラーは出ないんですが、実行された後も見られないんです。何処が駄目なんでしょうか??どなたかアドバイスをよろしくお願い致します。

Option Explicit

Sub Macro1()

Dim fig As Long
Dim num As Variant

For fig = 1 To 60000

num = Cells(fig, 1).Value

If num > -1 Then
Else
  
  Rows(fig).Select
  Selection.Delete Shift:=xlUp

End If
Next fig

End Sub

【58477】Re:条件に当てはまる行を削除
発言  こぎつね  - 08/10/27(月) 17:50 -

引用なし
パスワード
   ▼すー さん:
>最近VBAを始めた初心者ですが、どうか皆さん力を貸して下さい。
>
>エクセルで、A列のセルに数値以外のものが入ってる時、その行を削除(上にスクロール)できる様なマクロを作成しましたが、どうも上手く動作しません。エラーは出ないんですが、実行された後も見られないんです。何処が駄目なんでしょうか??どなたかアドバイスをよろしくお願い致します。
>

下から実行する事と、数値に変換できない値であるかで判断した場合、

Sub Macro1_test()

Dim fig As Long

For fig = 60000 To 1 Step -1

If Not IsNumeric(Cells(fig, 1).Value) Then
  Rows(fig).Select
  Selection.Delete Shift:=xlUp
End If
Next fig

End Sub
こんな感じでしょうか?
ただ60000行から実行する場合があるのかが疑問ですけど。

【58480】Re:条件に当てはまる行を削除
発言  Hirofumi  - 08/10/27(月) 19:17 -

引用なし
パスワード
   データの量が多い場合は1行づつ削除では遅いので
先に、隣の列に削除Flagを立てて、それをKeyにソートし
下の行に削除する行を集めて一気に削除します

Option Explicit

Public Sub Sample2()

  '◆データ列数(A列のみ)
  Const clngColumns As Long = 1
  '◆Keyと成る列を指定(基準セル位置からの列Offsetで指定:基準がA列なので0)
  Const clngKeys As Long = 0
  
  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim lngDelete() As Long
  Dim lngCount As Long
  Dim strProm As String

  '◆Listの先頭セル位置を基準とする(A列のデータ先頭のセル位置)
  Set rngList = ActiveSheet.Cells(1, "A")

  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngKeys).End(xlUp).Row - .Row + 1
    If lngRows <= 1 And .Value = "" Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'A列データを配列に取得
    vntData = .Offset(, clngKeys).Resize(lngRows + 1).Value
    '削除Flag用の配列を確保
    ReDim lngDelete(1 To lngRows, 1 To 1)
  End With
  
  '数値以外なら削除Flagに1を立てる
  For i = 1 To lngRows
    '数値以外なら
    If (Not IsNumeric(vntData(i, 1))) Or (IsEmpty(vntData(i, 1))) Then
      'Flagに1を立てる
      lngDelete(i, 1) = 1
      '削除行数をカウント
      lngCount = lngCount + 1
    End If
  Next i
    
  '画面更新を停止
  Application.ScreenUpdating = False
  
  With rngList
    '削除行が有るなら
    If lngCount > 0 Then
      'FlagをL列に出力
      .Offset(, clngColumns).Resize(lngRows) = lngDelete
      '空白行を最終行に集める為、L列をKeyとして整列
      .Resize(lngRows, clngColumns + 1).Sort _
          Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
          Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom, SortMethod:=xlStroke
      '削除行を削除
      .Offset(lngRows - lngCount).Resize(lngCount).EntireRow.Select
      .Offset(lngRows - lngCount).Resize(lngCount).EntireRow.Delete
      '削除Flag列を削除
      strProm = lngCount & "件の削除処理が完了しました"
    Else
      strProm = "削除行は有りません"
    End If
  End With
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

【58485】Re:条件に当てはまる行を削除
発言  ponpon  - 08/10/27(月) 20:42 -

引用なし
パスワード
   ▼すー さん:
>最近VBAを始めた初心者ですが、どうか皆さん力を貸して下さい。
>
>エクセルで、A列のセルに数値以外のものが入ってる時、その行を削除(上にスクロール)できる様なマクロを作成しましたが、どうも上手く動作しません。


関数を使って判断する方法です。
久しぶりの回答で、うまくいくといいのですが・・・

シート名はそちらにあわせてください。

Sub test2()
  With Sheets("Sheet1")
    With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Offset(, 26)
       .Formula = "=if(isnumber(A1),"""",1)"
      On Error Resume Next
         .SpecialCells(3, 1).EntireRow.Delete
         .ClearContents
      On Error GoTo 0
    End With
  End With
End Sub

【58487】Re:条件に当てはまる行を削除
発言  Hirofumi  - 08/10/27(月) 21:48 -

引用なし
パスワード
   ごめん、★印の行は確認用に入れたコードで
本来、必要ありませんので、削除して下さい

>  With rngList
>    '削除行が有るなら
>    If lngCount > 0 Then
>      'FlagをL列に出力
>      .Offset(, clngColumns).Resize(lngRows) = lngDelete
>      '空白行を最終行に集める為、L列をKeyとして整列
>      .Resize(lngRows, clngColumns + 1).Sort _
>          Key1:=.Offset(, clngColumns), Order1:=xlAscending, _
>          Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
>          Orientation:=xlTopToBottom, SortMethod:=xlStroke
>      '削除行を削除
'★削除   .Offset(lngRows - lngCount).Resize(lngCount).EntireRow.Select
>      .Offset(lngRows - lngCount).Resize(lngCount).EntireRow.Delete
>      '削除Flag列を削除
>      strProm = lngCount & "件の削除処理が完了しました"
>    Else
>      strProm = "削除行は有りません"
>    End If
>  End With

【58500】Re:条件に当てはまる行を削除
お礼  すー  - 08/10/28(火) 15:02 -

引用なし
パスワード
   みなさんご回答どうもありがとうございます。
難しくてわからないことも多かったんですが、参考にして書き換えてみますね。

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