いくつかのフィールドの値を連結する文字列が重複する値が存在することを示しているレコードを削除して、いくつかのレコードを逆方向にループするコードを作成しました。物を作るのに頭がおかしくなりましたが、以前に実行したときは問題なく動作しているようで、デバッガーを使用してマクロをステップ実行しても問題はありませんでしたが、正しく実行されなくなり、理由がわかりません。エラー1004-複数のセルの内容を連結して文字列を作成した時点で、アプリケーション定義またはオブジェクト定義のエラーが発生します。
システムリソースのような問題ではないかと思いましたが、どうしてそうなるのかよくわかりません。
Private Sub RemoveDuplicates(Endrow)
' A sub to remove data where Species, Location (Lat and Long) and accuracy are all the same and to return the most recent year
' whilst ignoring older records.
' This leaves the lowest row number of a set of duplicates since the sheet has been sorted by the previous function to put
' The highest date on the lowest row number.
Endrow = Range("A1").End(xlDown).Row
EndCol = Range("A1").End(xlToRight).Column
Dim iString As String
Dim iPlusString As String
Dim i As Integer
With ActiveSheet
For i = Endrow To 2 Step -1
Startloop:
iString = .Cells(i, 1).Value & .Cells(i, 2).Value & .Cells(i, 3).Value & .Cells(i, 12).Value
iPlusString = .Cells(i + 1, 1).Value & .Cells(i + 1, 2).Value & .Cells(i + 1, 3).Value & .Cells(i + 1, 12).Value
'This was just to watch where the data was to make things easier.
'Rows(i).Select
If i = Endrow Then
i = i - 1
GoTo Startloop
Else
If Stringi = iPlusString Then
Rows(i + 1).Delete
Else
i = i - 1
GoTo Startloop
End If
End If
Next
End With
End Sub
おそらくRemoveDuplicates、Rangeオブジェクトのメソッドを使用する方が簡単でしょう。
テストするデータがない場合、次のようになります。
Option Explicit
Sub RemoveDuplicates()
Dim endRow As Long, endCol As Long, dtCol As Long
Dim WS As Worksheet
Dim rg As Range
Set WS = Worksheets("sheet3")
With WS
endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
endCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rg = .Range(.Cells(1, 1), .Cells(endRow, endCol))
dtCol = rg.Rows(1).Find(what:="Date").Column
End With
'Optional to Sort with most recent date first, if not already sorted this way
rg.Sort key1:=rg.Columns(dtCol), order1:=xlDescending, Header:=xlYes
'remove duplicates
rg.RemoveDuplicates Array(1, 2, 3, 12), xlYes
End Sub
この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。
侵害の場合は、連絡してください[email protected]
コメントを追加