Extraire des données

[Jucyla]

Bonjour le forum,

dans le cadre d'un jeu j'aurais besoin de votre aide

J'aurais besoin d'extraire des données selon certaines valeurs présente dans un onglet.
Je vais essayer d'expliquer au mieu, mais ce n'est pas simple simple .

Dans l'onglet nommé "Jucyla_Source" du code html copié en tant que texte.
J'aurais besoin d'en extraire certaines lignes et de les mettre dans l'onglet nommé "Jucyla"

les lignes qui doivent être extraites sont les lignes qui contiennent les textes suivants :

- char-portrait-full-img
- star star
- char-portrait-full-level
- char-portrait-full-gear-level

il faut bien entendu que cela suive l'ordre du l'onglet "Jucyla_Source"
J'ai souligné en vert dans l'onglet "Jucyla_Source" les lignes qu'il faudrait récupéré des 3 premiers personnages
J'ai également souligné en vert les 2 derniers personnages.
L'idée étant de récupérér les lignes demandées pour chaque personnage, et donc de les mettre dans l'onglet nommé "Jucyla"
Dans l'onglet "Jucyla", j'ai mis ce que je voudrais arriver à faire, donc les 3 premiers personnages, ensuite tous les autres, et pour finir j'ai mis également les 2 derniers.

Merci pour toute l'aide apportée, cela me fera gagner des jours entiers

 

[Jucyla]

Merci beaucoup ton code fonctione

Je vais essayer maintenant d'intégrer tout ça avec le code de Staple1600 , on rentre dans mon domaine : la bidouille
Je n'ose montrer ce que donne mon fichier excel avec mes 50 feuilles , avec à l'intérieur le code dupliqué 50 fois en changeant le nom des feuilles, et où les différents bouts de code sont mis à la suite comme ça bêtement ^^
Je pense qu'on peut l'optimiser par 100 ce que j'ai fait, mais bon ça marche et ça me va bien

Merci encore Modeste, ainsi qu'a Staple pour le travail, et pour le temps consacré à ma demande

 

[Jucyla]

J'ai réussi à l'intégrer et ça marche merci encore .

Du coup pour vous faire rire, voilà "ma" macro en entier, sachant que j'ai fait 50 macros comme celle là avec le nom de chaque membre de ma guilde, et que j'ai fait une macro globale qui appelle les 50 macros.

vous allez voir comment c'est pas beau, mais ça marche

Sub Jucyla()

    Dim FileName As String
    Dim FileNum As Long
    Dim Sh As Worksheet
   
    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With
   
    Sheets("Jucyla").Select
    Cells.Select
    Selection.ClearContents
   
    Sheets.Add.Name = "Jucyla_S"
   
   
    FileName = "C:\Temp\Source.txt"
    FileNum = FreeFile
    Open FileName For Output As FileNum
    Print #FileNum, GetSource("https://swgoh.gg/u/jucyla/collection/")
    Close FileNum
    Set Sh = Worksheets.Add
        With Sh.QueryTables.Add(Connection:="TEXT;C:\TEMP\Source.txt", Destination:=Range("a1"))
        .Name = "Source"
        .AdjustColumnWidth = True
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = Array(2)
        .Refresh BackgroundQuery:=False
    End With
   
    Columns("A:A").Select
    Selection.Copy
   
    Sheets("Jucyla_S").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("A1").Select
   
   
   
    Dim DL&, LD&
Application.ScreenUpdating = False
With Worksheets("Jucyla_S")
    .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    DL = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To DL
    If InStr(1, .Cells(i, 1), "<img class=""char") > 0 Then
    LD = Worksheets("Jucyla").Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(i, 1).Resize(11).Copy
    Worksheets("Jucyla").Cells(LD, 1).PasteSpecial xlValues
    End If
    Application.CutCopyMode = False
    Next
End With
Worksheets("Jucyla").Range("A:A").Columns.AutoFit

     
   
   
    Dim EL&, ED&, j&, a$, b$, c$, d$, x&
Application.ScreenUpdating = False
j = 1
With Worksheets("Jucyla")
  EL = .Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To EL
  If InStr(1, .Cells(i, 1), "<img class=""char-portrait-full") > 0 Then
  On Error Resume Next
  a = Split(.Cells(i, 1).Text, """")(UBound(Split(.Cells(i, 1).Text, """")) - 1)
  c = Split(Split(.Cells(i + 9, 1).Text, ">")(1), "<")(0)
  d = Split(Split(.Cells(i + 10, 1).Text, ">")(1), "<")(0)
  For j = 1 To 7
  If InStr(1, .Cells(i + 1 + j, 1), "inactive") = 0 Then
  x = x + 1
  End If
  Next
  b = x
  .Cells(i, "B").Resize(, 4) = Array(a, b, c, d)
  x = 0
  End If
  Next
  .Columns("B:E").Columns.AutoFit
  .Columns(1).Delete
  .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With

   
   
Set trouve = Sheets("Jucyla_S").[A:A].Find(what:="Last updated:", LookIn:=xlValues, lookat:=xlPart)
If Not trouve Is Nothing Then
    débutDate = Mid(trouve, InStr(1, trouve, "title=", vbTextCompare) + 7, 30)
    Sheets("Jucyla").[F1] = Trim(Left(débutDate, InStr(1, débutDate, "UTC", vbTextCompare) - 1))
Else
    MsgBox "Pas trouvé la mention ""Last updated"" en colonne A"
End If
   
   
   
   
   
    Sheets("Jucyla_S").Select
    ActiveWindow.SelectedSheets.Delete
    Application.ScreenUpdating = True
    Sheets("Macro").Select
   
   
    On Error Resume Next
Application.DisplayAlerts = False
For i = 1 To 100
  sheetname = Cells(i + 1, 1).Value
  ActiveWorkbook.Sheets(sheetname).Delete
Next
Application.DisplayAlerts = True
   

End Sub

ahaha je suis nulle mais gâce à vous je suis arrivée à ce que je voulais

 

[Modeste]

vous allez voir comment c'est pas beau, mais ça marche

Merci pour ce petit moment de "je ne me prends pas la tête et je me prends encore moins au sérieux" ça nous fait un petit coup de fraîcheur!

Juste pour ta culture personnelle (on ne sait jamais que tu voudrais passer plus de temps à programmer qu'à jouer ) on conseille en général d'éviter l'instruction Select: en les multipliant, tu ralentis l'exécution de ton code. Tu peux écrire:

Sheets("Jucyla").Cells.ClearContents

... au lieu de:

Sheets("Jucyla").Select
Cells.Select
Selection.ClearContents

Bonne continuation,

 

[Jucyla]

Je suis contente alors pour le petit moment de fraîcheur apporté

Du temps pour programmer j'aimerais bien , franchement quand j'arrive à voir ce que vous arrivez à faire , ça me laisse rêveuse, j'adorerais savoir ça m'aiderait plein de fois.

Mais je suis preneuse de tout conseil, du coup merci beaucoup pour l'info que tu viens de me donner, je vais modifier le code, car mine de rien ma macro elle doit tourner pas loin d'une heure , et encore j'ai mis le calcul d'excel en manuel. Alors si je peux gagner un peu de temps gâce à ce que tu viens de me dire , c'est super