0

iveはいくつかのソースからまとめられたURLのリストを取得しました。ソースの一部は重複しているため、重複したリストがありますが、完全に重複しているわけではありませんが、http：//、www。、末尾にスラッシュなどがあります。 。

現時点で、iveは正確な複製で機能するスクリプトを入手しましたが、上記のように機能するようにinitを変更する必要がありますか？

これはiveがこれまでに得たものです

Sub Delete_duplicates()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
   ' Loop through records.
   For iCtr = 1 To iListCount
      ' Don't compare against yourself.
      ' To specify a different column, change 1 to the column number.
      If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
         ' Do comparison of next record.
         If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
            ' If match is true then delete row.
            Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
               ' Increment counter to account for deleted row.
               iCtr = iCtr + 1
         End If
      End If
   Next iCtr
   ' Go to next record.
   ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
4

1 に答える 1

1

関数を使用して URL を「正規化」できます。

...
            If strapUrl(ActiveCell) = strapUrl(Sheets("Sheet1").Cells(iCtr, 1)) Then
...

Function strapURL(Arg As String) As String
Dim Tmp As String

    Tmp = Replace(Arg, "http://", "")     ' remove http://
    Tmp = Replace(Tmp, "www.", "")        ' remove www.
    If Right(Tmp, 1) = "/" Then
        Tmp = Left(Tmp, Len(Tmp) - 1)     ' remove trailing /
    End If
    strapURL = Tmp

End Function

この関数をワークシート内のいくつかのサンプルに適用すると、次の結果が得られます

http://www.mydomain.com/    mydomain.com
www.mydomain.com/           mydomain.com
mydomain.com/               mydomain.com
http://www.mydomain.com     mydomain.com
www.mydomain.com            mydomain.com
mydomain.com                mydomain.com

これにより、「等しい基準」で URL を比較できます。

于 2012-12-19T08:12:02.757 に答える