200.000 個の電子メール アドレス (1 行に 1 つ) を含むテキスト ファイル (または Excel) があります。元のアドレスを含め、重複しているすべてのアドレスを削除する必要があるため、この例は次のとおりです。
a@a.com
b@a.com
b@a.com
c@a.com
d@a.com
両方の b@a.com エントリを削除する必要があります。200.000 行をループせずにこれを行う方法を知っている人
200.000 個の電子メール アドレス (1 行に 1 つ) を含むテキスト ファイル (または Excel) があります。元のアドレスを含め、重複しているすべてのアドレスを削除する必要があるため、この例は次のとおりです。
a@a.com
b@a.com
b@a.com
c@a.com
d@a.com
両方の b@a.com エントリを削除する必要があります。200.000 行をループせずにこれを行う方法を知っている人
例として前の投稿を使用して、ステートメントを変更しました。コードを実行すると、必要なデータを含む新しいシートが作成されます。ConnString
行がファイルを指していることを確認し、単語emailcolumn
を電子メール アドレスを含む列の名前に変更する必要があります。
電子メール アドレスを含むシートは Sheet1 と呼ばれ、データは新しいシートの列 A に移動すると仮定しました (必要に応じてコードを変更します)。
Sub Excel_QueryTable()
Sheet2.Cells.ClearContents
Dim oCn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim ConnString As String
Dim SQL As String
Dim qt As QueryTable
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\t.xlsm;Extended Properties=Excel 8.0;Persist Security Info=False"
Set oCn = New ADODB.Connection
oCn.ConnectionString = ConnString
oCn.Open
SQL = "Select emailcolumn from [Sheet1$] GROUP BY emailcolumn HAVING COUNT(emailcolumn) = 1"
Set oRS = New ADODB.Recordset
oRS.Source = SQL
oRS.ActiveConnection = oCn
oRS.Open
Set qt = Worksheets(2).QueryTables.Add(Connection:=oRS, _
Destination:=Range("A1"))
qt.Refresh
If oRS.State <> adStateClosed Then
oRS.Close
End If
If Not oRS Is Nothing Then Set oRS = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
End Sub
VBA は必要ありません。単に列を並べ替えて、セルの値がセルの上または下と同じかどうかを確認してから、フィルターを TRUE に使用します。このようなもの:
=OR(A2=A1,A2=A3)