Suppression de ligne quand il y a un texte

Le 19/11/2015 à 11:22

Bonjour,

J'aimerais comment faire pour que dans mon code VBA, que celui-ci détecte les mots "Heure" et "Locale" pour par la suite supprimer les lignes en question.

Merci par avance de votre aide.

13recuperation-de-donnees-v002.xlsm (49.00 Ko)

Le 19/11/2015 à 11:52

Bonjour

Sub tt()
    a = Feuil1.UsedRange.Rows.Count
    With Feuil1
        For i = a To 2 Step -1
            If .Cells(i, 2) = "Heure" Or .Cells(i, 2) = "locale" Then Rows(i).Delete
        Next
    End With
End Sub

Le 19/11/2015 à 12:06

Bonjour,

Une autre proposition.

Cdlt.

Public Sub CleanData()
Dim ws As Worksheet, lastRow As Long, rw As Long

    Application .ScreenUpdating = False

    Set ws = ActiveSheet

    With ws
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For rw = lastRow To 2 Step -1
            If UCase(.Cells(rw, 2)) = "HEURE" Or UCase(.Cells(rw, 2)) = "LOCALE" Then
                .Rows(rw).Delete
            End If
        Next rw
        'lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        '.Range(.Cells(2, 2), .Cells(lastRow, 2)).Replace " h", vbNullString
        '.Range(.Cells(2, 3), .Cells(lastRow, 3)).Replace " °C", vbNullString
    End With

    Set ws = Nothing

End Sub

Le 19/11/2015 à 15:43

J'ai une erreur dans le code.

Le 19/11/2015 à 16:24

Ou est mon erreur ?

Sub Macro1()
'
' Macro1 Macro
'

'
  Cells.Clear
'  Range("B2").Select
'  ActiveCell.FormulaR1C1 = ""
'  Range("B3").Select
  For j = 0 To 1
    For i = 1 To 31
      ligne = Range("B" & Rows.Count).End(xlUp).Row + 1
      Range("A" & ligne) = DateSerial(2014, j + 1, i)

      With ActiveSheet.QueryTables.Add(Connection:= _
                                       "URL;http://www.meteociel.fr/temps-reel/obs_villes.php?code2=7005&jour2=" & i & "&mois2=" & j & "&annee2=2014" _
                                       , Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1, 0))
        .Name = "obs_villes.php?code2=7005&jour2=3&mois2=3&annee2=2015"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
      End With
      Range("A" & ligne).AutoFill Destination:=Range("A" & ligne & ":A" & Range("B" & Rows.Count).End(xlUp).Row), Type:=xlFillCopy
    Next

  Next

Public Sub CleanData()
Dim ws As Worksheet, lastRow As Long, rw As Long

    Application .ScreenUpdating = False

    Set ws = ActiveSheet

    With ws
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For rw = lastRow To 2 Step -1
            If UCase(.Cells(rw, 2)) = "HEURE" Or UCase(.Cells(rw, 2)) = "LOCALE" Then
                .Rows(rw).Delete
            End If
        Next rw
        'lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       '.Range(.Cells(2, 2), .Cells(lastRow, 2)).Replace " h", vbNullString
       '.Range(.Cells(2, 3), .Cells(lastRow, 3)).Replace " °C", vbNullString
   End With

    Set ws = Nothing

End Sub

  Columns("C:E").Delete
  Columns("D:J").Delete
'  Columns("C:E").Select
'  Selection.Delete Shift:=xlToLeft
'  Columns("D:J").Select
'  Selection.Delete Shift:=xlToLeft

End Sub

Le 19/11/2015 à 16:26

Re,

Un espace s'est crée sur la ligne :