Excel VBA質問箱 IV

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

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


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

【38314】検索〜比較〜行削除 ゆっけ 06/5/31(水) 11:04 質問[未読]
【38317】Re:検索〜比較〜行削除 Statis 06/5/31(水) 11:29 回答[未読]
【38324】Re:検索〜比較〜行削除 ゆっけ 06/5/31(水) 13:00 質問[未読]
【38328】Re:検索〜比較〜行削除 Kein 06/5/31(水) 13:45 回答[未読]
【38351】Re:検索〜比較〜行削除 ゆっけ 06/5/31(水) 16:12 質問[未読]
【38352】Re:検索〜比較〜行削除 Kein 06/5/31(水) 16:30 発言[未読]
【38353】Re:検索〜比較〜行削除 ゆっけ 06/5/31(水) 17:55 お礼[未読]
【38372】Re:検索〜比較〜行削除 samugar 06/6/1(木) 8:33 発言[未読]
【38357】Re:検索〜比較〜行削除 Hirofumi 06/5/31(水) 20:02 回答[未読]

【38314】検索〜比較〜行削除
質問  ゆっけ  - 06/5/31(水) 11:04 -

引用なし
パスワード
   今回"まとめ"シートの中の"AB列"のなかにある、重複している
データがはいっている(複数重複している)セルを含む行を削除したく
以下のようなコードを作りました。
Sub まとめの整理()

Dim CV_r As Long
Dim F As Variant
Dim St As Long

CV_r = 10

For Each R In Range(Worksheets("まとめ").Range("AB1"), _
Worksheets("まとめ").Range("AB65536").End(xlUp))

Set F = Worksheets("まとめ").Range("AB:AB").Find(R.Value, , , xlPart, , , False, False)
     
If Not F Is Nothing Then
 With Worksheets("まとめ")
  .Cells(CV_r, 27).EntireRow.Delete
   CV_r = CV_r + 1
          
St = F.row
Set F = Worksheets("まとめ").Range("AB:AB").FindNext(F)
  Do While F.row <> F.row
   .Cells(CV_r, 27).EntireRow.Delete
   CV_r = CV_r + 1
   Set F = ws.Range("AB:AB").FindNext(F)
  Loop
 End With
End If
Next R
Worksheets("まとめ").Range("AB:AB").Clear
End Sub

うまくいかない原因を教えてください。

【38317】Re:検索〜比較〜行削除
回答  Statis  - 06/5/31(水) 11:29 -

引用なし
パスワード
   こんにちは
テスト環境でお試しを。(IV列を作業列で使います)

Sub Test()

With Worksheets("まとめ")
   With .Range("AB1", .Range("AB65536").End(xlUp)).Offset(, 228)
     .FormulaR1C1 = "=IF(COUNTIF(C[-228],RC[-228])>1,1,"""")"
     On Error Resume Next
     .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
     On Error GoTo 0
     .Clear
   End With
End With

End Sub

【38324】Re:検索〜比較〜行削除
質問  ゆっけ  - 06/5/31(水) 13:00 -

引用なし
パスワード
   ▼Statis さん:

ありがとうございす!

ただ、記述するのを忘れていたんですが、

重複しても、一つは残しておきたいので、検索元AB列の

セルの行は消さないでよい方法はあるでしょうか?

申し訳ございません。

例えば、AB列に"たまご"とあると、IV列の同じ行にある"たまご"は
残し、他のIV列行の"たまご"と書かれたセルの行は全て削除すると
いった感じです。

【38328】Re:検索〜比較〜行削除
回答  Kein  - 06/5/31(水) 13:45 -

引用なし
パスワード
   数式の内容が分かれば、改造の仕方も分かるはずなんですけど・・・。

Sub Test2()
  With Worksheets("まとめ")
   With .Range("AB1", .Range("AB65536").End(xlUp)).Offset(, 228)
     .Formula = "=IF(COUNTIF($AB$1:$AB1,$AB1)>1,1,"""")"
     On Error Resume Next
     .SpecialCells(3, 1).EntireRow.Delete
     .ClearContents
   End With
  End With
End Sub

少しは自分で考えてみること。

【38351】Re:検索〜比較〜行削除
質問  ゆっけ  - 06/5/31(水) 16:12 -

引用なし
パスワード
   ▼Kein さんへ

いつもすみません・・・・
コードの意味は理解できましたが、一点わからないことが
あります。

specialcellsのあとの3は何をあらわしているんでしょうか?
これが、分かりません。

【38352】Re:検索〜比較〜行削除
発言  Kein  - 06/5/31(水) 16:30 -

引用なし
パスワード
   その数値は文字定数に直すと xlCellTypeFormulas になります。
ついでに全ての数値定数と文字定数の関係を書いておきます。

xlCellTypeConstant = 2
xlCellTypeFormulas = 3
xlCellTypeBlanks = 4
xlCellTypeLastCell = 11
xlCellTypeVisible = 12
xlCellTypeComments = -4144
xlCellTypeAllFormatConditions = -4172
xlCellTypeSameFormatConditions = -4173
xlCellTypeAllValidation = -4174
xlCellTypeSameValidation = -4175
[第二引数]
xlNumbers = 1
xlTextValues = 2
xlLogical = 4
xlErrors = 16

【38353】Re:検索〜比較〜行削除
お礼  ゆっけ  - 06/5/31(水) 17:55 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございました。
調べたのですが、のっていなかったので・・・
すみません!

【38357】Re:検索〜比較〜行削除
回答  Hirofumi  - 06/5/31(水) 20:02 -

引用なし
パスワード
   もう見て居ないかな?

こんなのも有るよ

Option Explicit

Public Sub Repetition()

  'データの列数(基準位置からの列数、この列の1列外側を作業列にします)
  '例えば、基準セル位置がA列で、データがAB列まで有るなら
  Const clngColumns As Long = 28

  '重複を比較する列(基準列位置からの列Offset)
  '例えば、基準セル位置がA列で、比較列がAB列なら
  Const clngKeys As Long = 27
  
  Dim i As Long
  Dim lngRows As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim dicIndex As Object
  Dim lngFlags() As Long
  Dim strProm As String
    
  'データの左上隅を基準とする
  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
    'Keyを配列に取得
    vntData = .Offset(, clngKeys).Resize(lngRows + 1).Value
  End With
  'Flagを格納する配列を確保
  ReDim lngFlags(1 To lngRows, 1 To 1)

  Application.ScreenUpdating = False

  'Dictionaryオブジェクトを取得
  Set dicIndex = CreateObject("Scripting.Dictionary")

  With dicIndex
    'データ行数分繰り返し
    For i = 1 To lngRows
      'Keyの登録が有るなら(重複が有る)
      If .Exists(vntData(i, 1)) Then
        '削除フラグを立てる
        lngFlags(i, 1) = 1
        '削除数をカウント
        lngCount = lngCount + 1
      Else
        'Keyの登録
        .Add vntData(i, 1), Empty
      End If
    Next i
  End With
  
  Set dicIndex = Nothing

  With rngList
    '削除する行が合った場合
    If lngCount > 0 Then
      '削除フラグの配列をデータ列の右側に出力
      .Offset(, clngColumns).Resize(lngRows).Value = lngFlags
      '削除フラグの列を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.Delete
      ''削除フラグの列を消去
      .Offset(, clngColumns).EntireColumn.ClearContents
      strProm = lngCount & " 行の削除が完了しました"
    Else
      strProm = "重複行が有りません"
      GoTo Wayout
    End If
  End With

Wayout:

  Application.ScreenUpdating = True

  Set rngList = Nothing

  MsgBox strProm, vbInformation

End Sub

【38372】Re:検索〜比較〜行削除
発言  samugar  - 06/6/1(木) 8:33 -

引用なし
パスワード
   >xlCellTypeFormulas = 3
xlCellTypeFormulas は「定数名」または「組み込み定数」といいます。
定数名を「文字定数」と呼ぶと「文字列が入っている定数」と紛らわしいです。
(結局は初心者の理解の妨げになると思います。)

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