Supprimer ligne selon valeur de colonne (bd 200 000 lignes)
b
Bonjour et tout d'abord meilleurs vœux!!!
je souhaite :
- supprimer toutes lignes qui ont pour valeur 99999 de la colonne W
- supprimer toutes lignes qui ont pour valeur 2 de la colonne W
La BD fait environ 200 000 lignes.
et autre code pour supprimer toutes lignes qui ont pour valeur > 90 000 de la colonne W
(exemple en pj.)
Merci.
Invité
Bonjour voici du code pour les 2 questions (selon choix de la ligne Req= ...)
Option Explicit
' ***********************************************************************
' ***** *****
' ***** CODE PierreP56 : http://tatiak.canalblog.com/ *****
' ***** *****
' ***********************************************************************
Public Cnx As Object, Rst As Object
Public Req As String
Sub BBTO()
Dim T As Variant
Req = "SELECT * FROM [CA$A:AR] WHERE NOT `No ligne (NOL_TMP)` = 99999" & _
" AND NOT `No ligne (NOL_TMP)` = 2"
'Req = "SELECT * FROM [CA$A:AR] WHERE `No ligne (NOL_TMP)` < 90000"
Connect_xls ThisWorkbook.FullName
T = Select_Db(Req)
Close_Cnx
Sheets("CA").UsedRange.ClearContents
Sheets("CA").Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub
' *************************************************************************************************
Sub Connect_xls(Ndf As String)
Set Cnx = CreateObject("ADODB.Connection")
Cnx.provider = "MSDASQL"
Cnx.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Ndf & "; ReadOnly=False;"
Set Rst = CreateObject("ADODB.Recordset")
End Sub
Function Select_Db(Req As String, Optional Head As Integer = 1) As Variant
Dim T As Variant, Rcd As Variant, f As Integer
Dim lig As Long, Col As Long, i As Long, j As Long
On Error GoTo errhdlr
ReDim Rcd(1 To 1, 1 To 1)
Rst.Open Req, Cnx, 3
lig = Rst.RecordCount
If lig > 0 Then
Rst.MoveFirst
T = Rst.GetRows
Col = Rst.Fields.Count
ReDim Rcd(1 To lig + Head, 1 To Col)
For j = 0 To Col - 1
Rcd(1, j + 1) = Rst.Fields(j).Name
For i = 0 To lig - 1
Rcd(i + 1 + Head, j + 1) = IIf(IsNull(T(j, i)), Null, T(j, i))
Next i
Next j
End If
Select_Db = Rcd
Exit Function
errhdlr:
Rcd(1, 1) = Req & vbCrLf & "Erreur n°" & Err.Number & vbCrLf & Err.Description
Select_Db = Rcd
f = FreeFile()
Open ThisWorkbook.Path & "\Log.txt" For Append As #f
Print #f, Now() & " | " & Rcd(1, 1) & vbCrLf
Close #f
End Function
Sub Close_Cnx(Optional x As Byte)
On Error Resume Next
If x > 0 Then Rst.Close
If Cnx_IsOpen Then Cnx.Close
Set Cnx = Nothing
Set Rst = Nothing
End Sub
Function Cnx_IsOpen() As Boolean
On Error Resume Next
Cnx_IsOpen = (Cnx.State = 1)
End Function
' *************************************************************************************************Pierre