VBA STXT HT + autres modifications

Bonjour à tous,

J’espère que vous avez passé un super week-end !

Je viens à vous pour réaliser une macro qui je pense n’est pas très compliqué, mais sur laquelle je galère pour une action.

J’aimerais pouvoir écrire ce qu’il y a entre parenthèse dans les colonnes H et I à partir de la ligne 2 jusqu’à la dernière ligne où il y a du contenu les chiffres sans les parenthèses de cette façon.

En parallèle, j’aimerais profiter de cette macro pour renommer certaines cellules :

A1 = "date"

B1 = "H team"

C1 = "A team“

D1 = “H goal”

E1 = “A goal”

F1 = “H HT G”

G1 = “A HT G”

Également, j’aimerais supprimer la colonne B et D. Et j’aimerais pouvoir décaler les cellules de sorte à ce qui est en A1 soit en B2 comme dans l’image ci-dessous :

Je reste à votre disposition si besoin.

Je vous remercie par avance de votre aide et je vous souhaite une bonne journée !

Bonjour, l'enregistreur de macro est trés bien pour faire ce genre de chose. Enfin quand on le fait dans l'ordre

La suppression des colonnes avant d'indiquer les titres LOL.

Sub Macro1()

    Cells.Select
    Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "H team"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "A team"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "H goal"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "A goal"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "H HT G"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "A HT G"
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
End Sub

Bonjour à tous,

Une autre solution :

Option Explicit

Sub Test()

Dim I As Integer, DerniereLigne As Integer, DerniereColonne As Integer
Dim Sh As Worksheet

    Set Sh = Sheets("Récupéré_Feuil1 (2)")
    With Sh

         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonne = .Cells(1, .Columns.Count).End(xlToLeft).Column

         For I = DerniereColonne To 1 Step -1
             Select Case .Cells(1, I)
               Case "event__logo src", "event__logo src 2"
                     .Cells(1, I).EntireColumn.Delete
             End Select
         Next I
         .Range(.Cells(1, 1), .Cells(1, 7)) = Array("Date", "H team", "A team", "H goal", "A goal", "H HT G", "A HT G")

         For I = 2 To DerniereLigne

             TransformerLaCellule Sh, I, 4
             TransformerLaCellule Sh, I, 5
             TransformerLaCellule Sh, I, 6
             TransformerLaCellule Sh, I, 7

         Next I

         .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         .Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         .Cells.EntireColumn.AutoFit
         .Range("B2").Select

    End With

    MsgBox "Fin de mise à jour !", vbInformation

    Set Sh = Nothing

End Sub

Sub TransformerLaCellule(ByVal Sh2 As Worksheet, ByVal LigneEnCours As Integer, ByVal NumColonne As Integer)

    With Sh2
         If InStr(1, .Cells(LigneEnCours, NumColonne), "(", vbTextCompare) > 0 Then
            .Cells(LigneEnCours, NumColonne) = Mid(.Cells(LigneEnCours, NumColonne), 2)
            .Cells(LigneEnCours, NumColonne) = Val(Split(.Cells(LigneEnCours, NumColonne), ")")(0))
         Else
            .Cells(LigneEnCours, NumColonne) = Val(.Cells(LigneEnCours, NumColonne))
         End If
    End With

End Sub

Bonjour à tous,

Une variante...à tester....

Sub laplacea()
 Dim tb, Newtb(), titres()
 Dim i&, k&, j%

 titres = Array("Date", "H Team", "A Team", "H Goal", "A Goal", "H HT G", "A HT G")

 Application.ScreenUpdating = False

  With Sheets("Récupéré_Feuil1")
   tb = .Range("A1").CurrentRegion
   k = 0
   ReDim Newtb(0 To UBound(tb, 1), 1 To 7)
   For i = 2 To UBound(tb, 1)
     If tb(i, 1) <> "" Then
       Newtb(k, 1) = tb(i, 1) 'date
       Newtb(k, 2) = tb(i, 3) 'Hteam
       Newtb(k, 3) = tb(i, 5) 'Ateam
       Newtb(k, 4) = tb(i, 6) 'Hgoal
       Newtb(k, 5) = tb(i, 7) 'Agoal
       Newtb(k, 6) = Replace(Replace(tb(i, 8), "(", ""), ")", "") 'H Ht G
       Newtb(k, 7) = Replace(Replace(tb(i, 9), "(", ""), ")", "") 'A Ht G
       k = k + 1
     End If
   Next i

   If k > 0 Then
    On Error Resume Next
     .Cells.Borders.LineStyle = xlLineStyleNone
     .Cells.ClearContents
      For j = 0 To UBound(titres, 1)
      .Cells(1, 2 + j) = titres(j): .Cells(1, 2 + j).Font.Bold = True
      Next j
     .Range("B2").Resize(k, 7).Value = Newtb
     .Range("B1").CurrentRegion.Borders.Weight = xlThin
     .Columns("C:D").AutoFit
     .Columns("E:H").HorizontalAlignment = xlCenter
   End If
  End With
 Erase tb: Erase Newtb
End Sub

CTRL + e pour exécuter la macro...

Cordialement,

Bonjour xmenpl, Eric et xorsankukai (ça fait longtemps ! )

J'espère que vous allez bien

Je vous remercie de votre temps et de votre aide.

Vos macros fonctionnent parfaitement et me permettent d'avancer à a prochaine étape.

Merci mille fois !

Très bonne journée à vous.

Laplacea