Extraction de données

Y compris Power BI, Power Query et toute autre question en lien avec Excel
d
duee
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 25 octobre 2018
Version d'Excel : 2010en

Message par duee » 29 octobre 2018, 19:55

Bonjour je suis sur un sujet qui me pose problème
Sur des listes de soudure que je relève sur un robot et que je voudrais extraire des informations dans d'autres cellules pour créer une base de données sous Excel
voir fichier joint
Merci
listedesoudure.xlsx
(9.86 Kio) Téléchargé 15 fois
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 227
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 29 octobre 2018, 20:48

Salut duee,

premier jet, vite fait... Je peaufine dans la soirée.
Un double-clic en 'Extract' démarre la macro. Résultat en 'BDD'.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract(), tSplit1, tSplit2
'
tData = Range("A1").Resize(UsedRange.Rows.Count, 1).Value
With Worksheets("BDD")
    For x = 1 To UBound(tData, 1)
        If tData(x, 1) <> "" Then
            iRow = IIf(.Cells(1, 1) = "", 1, .Range("A" & Rows.Count).End(xlUp).Row + 1)
            .Cells(iRow, 1) = Split(Split(tData(x, 1), " =")(0), " ")(1)
            tSplit1 = Split(Split(tData(x, 1), "= (")(1), ")")(0)
            tSplit2 = Split(tSplit1, ",")
            .Range("B" & iRow).Resize(1, UBound(tSplit2, 1)).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(tSplit2))
        End If
    Next
End With
'
End Sub
8-)
A+
listedesoudure.xlsm
(17.02 Kio) Téléchargé 19 fois
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 594
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 29 octobre 2018, 22:02

Bonsoir à tous, :)

Un essai :
Option Explicit
Sub test()
Dim x, y(), i As Long, j As Long
    With Sheets(1)
        With .Range("A4", .Cells(.Rows.Count, 1).End(xlUp))
            x = .Value
            ReDim y(1 To UBound(x, 1), 1 To 23)
            With CreateObject("VBScript.RegExp")
                .Global = True: .Pattern = "\d+"
                For i = 1 To UBound(x, 1)
                    For j = 0 To .Execute(x(i, 1)).Count - 1
                        y(i, j + 1) = .Execute(x(i, 1))(j)
                    Next
                Next
            End With
            .Offset(, 2).Resize(UBound(y, 1), UBound(y, 2)).Value = y
        End With
    End With
End Sub
Il faut changer le pattern, les nombres négatifs n'apparaissent pas :oops:

klin89
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 227
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 29 octobre 2018, 22:17

Salut tout le monde,

petites corrections... trop vite, c'est trop vite...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tSplit1
'
Cancel = True
Application.ScreenUpdating = False
'
tData = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
With Worksheets("BDD")
    iRow = IIf(.Cells(1, 1) = "", 0, .Range("A" & Rows.Count).End(xlUp).Row)
    For x = 1 To UBound(tData, 1)
        If tData(x, 1) <> "" Then
            iRow = iRow + 1
            .Cells(iRow, 1) = Split(Split(tData(x, 1), " =")(0), " ")(1)
            tSplit1 = Split(Split(Split(tData(x, 1), "= (")(1), ")")(0), ",")
            .Range("B" & iRow).Resize(1, UBound(tSplit1, 1) + 1).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(tSplit1))
        End If
    Next
End With
'
Application.ScreenUpdating = True
'
End Sub
:btres:

8-)
A+
listedesoudure.xlsm
(17.59 Kio) Téléchargé 11 fois
Modifié en dernier par curulis57 le 30 octobre 2018, 01:05, modifié 2 fois.
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 594
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 29 octobre 2018, 22:38

Un petit oubli curulis57, :wink:
.Range("B" & iRow).Resize(1, UBound(tSplit1, 1) + 1).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(tSplit1))
klin89
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 227
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 29 octobre 2018, 23:36

Salut Klin,

joli coup d'oeil! :clap:
Trop sûr de mon coup, je n'avais pas regardé le bout des lignes de résultats... hors écran!
Corrigé dans le post précédent...

Merci.
:)
A+
g
gmb
Fanatique d'Excel
Fanatique d'Excel
Messages : 12'667
Appréciations reçues : 346
Inscrit le : 4 avril 2013
Version d'Excel : 2016

Message par gmb » 30 octobre 2018, 00:10

Bonjour à tous

Un essai à tester.
Bye !
listedesoudure v1.xlsm
(19.26 Kio) Téléchargé 15 fois
d
duee
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 25 octobre 2018
Version d'Excel : 2010en

Message par duee » 30 octobre 2018, 20:51

je vous remercie beaucoup les amis pour les programmes de mon sujet ,je suis très content que vous avez résolus mon problème
sa fonction très bien
Merci et bonne soirée a tous
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 594
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 31 octobre 2018, 22:23

re duee :)

remplace le pattern ci dessous :
.Pattern = "\d+"
par celui-ci
.Pattern = "-?\d+"
klin89
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Extraction de données
    par fredolilo » 13 octobre 2016, 18:20 » dans Excel - VBA
    5 Réponses
    148 Vues
    Dernier message par fredolilo
    14 octobre 2016, 09:13
  • extraction de données
    par jad73 » 12 avril 2015, 10:29 » dans Excel - VBA
    2 Réponses
    127 Vues
    Dernier message par jad73
    12 avril 2015, 12:01
  • extraction de donnees
    par lamineyassine » 11 avril 2016, 18:46 » dans Excel - VBA
    4 Réponses
    154 Vues
    Dernier message par fred2406
    14 avril 2016, 11:36
  • Extraction donnees
    par miha » 4 février 2018, 22:33 » dans Excel - VBA
    1 Réponses
    103 Vues
    Dernier message par i20100
    5 février 2018, 06:23
  • Extraction de données
    par fredolilo » 30 décembre 2016, 13:06 » dans Excel - VBA
    4 Réponses
    199 Vues
    Dernier message par fredolilo
    2 janvier 2017, 11:02
  • Extraction de données
    par Beberttlse31 » 17 octobre 2018, 22:49 » dans Excel - VBA
    8 Réponses
    115 Vues
    Dernier message par curulis57
    19 octobre 2018, 23:24