Importation + supression de lignes

abcmedia.ch

XLDnaute Nouveau
Bonjour a tous,
Je suis nouveau dans le forum.... et bien sûr à la recherche d'une solution.
Aussi je débute avec le VBA et je rencontre quelques soucis.

Je suis entrain de créer un fichier excel qui comporte des macros et importe des données depuis un fichier texte puis création de tableaux croisés dynamiques. Jusque là ça marche pas trop mal. :)

Mais j'aimerais supprimer toutes les lignes qui ont un mot clé spécifique dans la colonne B

L'import et la mise en place se fait correctement, la création des tablaux dynamiques aussi mais pas la suppression des ligne...
Es-ce que quelqu'un aurait une idée?
Merci infiniment

J'utilise Excel 2007
Voici mon code :
Sub Importation()
'
' Importation Macro
' Importation fichier FileSystem
'

'
Sheets("Feuil1").Select
Sheets("Feuil1").Name = "Sources Importation"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Temp\Audit_FileSystem\FGUR_2Niv-2.txt", Destination:=Range("$A$1"))
.Name = "FGUR_2Niv-2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Sub Suprimerlignes()
' Suprimerlignes Macro
Dim c As Range
Do
Set c = Range("B:B").Find(What:="EU\administrator,EU\SUPVILO", _
After:=Range("B1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not c Is Nothing Then
c.EntireRow.Delete
End If
Loop Until c Is Nothing


End Sub
 
G

Guest

Guest
Re : Importation + supression de lignes

Bonsoir,

Pour la suppression des lignes:
Code:
[COLOR=BLUE]Sub[/COLOR] Suprimerlignes()
[COLOR=GREEN]' Suprimerlignes Macro[/COLOR]
    [COLOR=BLUE]Dim[/COLOR] c [COLOR=BLUE]As[/COLOR] Range
    [COLOR=BLUE]Dim[/COLOR] Adr [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]String[/COLOR]
        [COLOR=BLUE]Set[/COLOR] c = Range([i]"B:B"[/i]).Find(What:=[i]"EU\administrator,EU\SUPVI LO"[/i], _
                                  After:=Range([i]"B1"[/i]), _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByColumns, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=[COLOR=BLUE]False[/COLOR])
                                  
        [COLOR=BLUE]If[/COLOR] [COLOR=BLUE]Not[/COLOR] c [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]Then[/COLOR]
            Adr = c.Address
            [COLOR=BLUE]Do[/COLOR]
                c.EntireRow.Delete
                [COLOR=BLUE]Set[/COLOR] c = Range([i]"B:B"[/i]).FindNext(c)
            [COLOR=BLUE]While[/COLOR] [COLOR=BLUE]Not[/COLOR] c [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]And[/COLOR] c.Address <> Adr
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

Un excelent exemple est donné dans l'aide excel! Magique F1 sur find!

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 103
Messages
2 085 312
Membres
102 860
dernier inscrit
fredo67