Autres Organiser des données sur VBA

KManu · 10 Novembre 2021

Bonjour à tous,

je suis face une difficulté et j'ai un délai très court pour trouver une solution.
Je souhaite organiser des données transmises par un capteur.
Le transfert des fichiers du capteur à mon outils numérique récepteur est désorganisé de la sorte:
exemple:
100.42,0.00,26.17,100.38,0.00,26.18,100.34,0.00,26.22,100.40, (Ligne 1)
0.00,26.22,100.39,0.00,26.20,100.41,0.00,26.20,100.38, (Ligne 2)
0.00,26.19,100.34,0.00,26.19, (..............)
100.45,0.00,26.19,100.34, (..............)
0.00,26.19,100.41,0.00,26.19,100.39, (..............)
0.00,26.22,100.44,0.00,26.22,100.38,0.00,26.19,100.39, (Ligne n)

En gros, on a l'heure de mesure, le débit (00,0), la Température (26 °c en moyenne) et la pression (100 kpa en moyenne).

comment pourrais-je écrire mon code VBA pour obtenir afin d'avoir 3 colonnes (une pour chaque paramètre) et que sur une ligne de plus de 3 données, les valeurs suivantes soient reportées sur une ligne inférieure (insérée) et également par lot de 3 . Un exemple, si je considère la Ligne 1, j'obtiendrais:
0.00, 26.17, 100.38,
0.00, 26.18, 100.34, (ligne insérée et couper/coller des 3 données à la suite des 3 premières)
0.00, 26.22, 100.40, (ligne insérée et couper/coller des 3 données à la suite des 3 secondes)

Merci à tous.
Je tiens à signaler que je travaille sur d'autres logiciels, et que concernant VBA je suis actuellement en train de m'autoformer.

Bernard_XLD · 10 Novembre 2021

re,

Code modifié, un peu plus rapide

Cordialement, @+

VB:

Sub Import_donnees()
    Dim Tablo, Tablo2$, Tablo3$(), Val_Tab$, x&, y&, z&, i&, Nom_Fichier$
    With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Lire"
        .AllowMultiSelect = False
        .Title = "Choisissez le fichier à importer"
        .Filters.Clear
        .Filters.Add "Extraction données", "*.txt; *.txt", 1
        .Show
        If .SelectedItems.Count > 0 Then
            Nom_Fichier = .SelectedItems(1)
        Else
            MsgBox "Aucun fichier sélectionné", vbOKOnly + vbInformation, "Information"
            Exit Sub
        End If
    End With
    Workbooks.OpenText Filename:=Nom_Fichier, Origin:=xlMSDOS, _
        StartRow:=1...

Bernard_XLD · 10 Novembre 2021

Bonjour Kmanu, le forum

Avec un fichier de test, cela serait mieux ! les données sont précisément stockées en cellules comme vous l'indiquez ?

Cordialement, @+

sylvanu · 10 Novembre 2021

Bonjour Kmanu et bienvenu sur XLD,
Essayez toujours de fournir un fichier test, c'est plus simple, plus parlant, et permet de faire un VBA mieux ciblé. 🙂
En PJ un essai avec :

VB:

Sub Transfert()
    Dim i%, Ligne%, Chaine$, tablo
    Application.ScreenUpdating = False
    On Error GoTo Fin
    ' On concatène toutes les données en une seule chaine
    For i = 1 To Sheets("Feuil1").Range("A65500").End(xlUp).Row
        Chaine = Chaine & Sheets("Feuil1").Cells(i, "A")
    Next i
    ' On splite cette chaine avec la virgule comme séparateur
    tablo = Split(Chaine, ",")
    Ligne = 1
    With Feuil2
        ' On efface la feuille 2
        .Range("A:C").ClearContents
        ' On redistribue les données
        For i = 1 To UBound(tablo) Step 3
            .Cells(Ligne, "A") = tablo(i)
            .Cells(Ligne, "B") = tablo(i + 1)
            .Cells(Ligne, "C") = tablo(i + 2)
            Ligne = Ligne + 1
        Next i
    End With
Fin:
    Application.ScreenUpdating = True
End Sub

Les données sont en feuille 1, le résultat en feuille 2.

KManu · 10 Novembre 2021

Yeahou à dit:
Bonjour Kmanu, le forum

Avec un fichier de test, cela serait mieux ! les données sont précisément stockées en c ellules comme tu l'indiques ?

Cordialement, @+

Yeahou à dit:
Bonjour Kmanu, le forum

Avec un fichier de test, cela serait mieux ! les données sont précisément stockées en cellules comme vous l'indiquez ?

Cordialement, @+

Bonjour Yeahou,
merci bcp pour le retour prompt.
Justement, les données sont plus ou moins bien stockées en cellules.
Je joins un fichier exemple.
Déjà, je me pose la question de savoir si VBA est le bon outils à mon problème.

Bien cordialement
KManu

Bernard_XLD · 10 Novembre 2021

Re,
On dirait des données déjà importées et (mal) transformées, vous n'avez pas un fichier brut d'export en txt ou csv ?
Ce serait plus simple de partir directement de la source

KManu · 10 Novembre 2021

sylvanu à dit:

Bonjour Kmanu et bienvenu sur XLD,
Essayez toujours de fournir un fichier test, c'est plus simple, plus parlant, et permet de faire un VBA mieux ciblé. 🙂
En PJ un essai avec :

VB:

Sub Transfert()
    Dim i%, Ligne%, Chaine$, tablo
    Application.ScreenUpdating = False
    On Error GoTo Fin
    ' On concatène toutes les données en une seule chaine
    For i = 1 To Sheets("Feuil1").Range("A65500").End(xlUp).Row
        Chaine = Chaine & Sheets("Feuil1").Cells(i, "A")
    Next i
    ' On splite cette chaine avec la virgule comme séparateur
    tablo = Split(Chaine, ",")
    Ligne = 1
    With Feuil2
        ' On efface la feuille 2
        .Range("A:C").ClearContents
        ' On redistribue les données
        For i = 1 To UBound(tablo) Step 3
            .Cells(Ligne, "A") = tablo(i)
            .Cells(Ligne, "B") = tablo(i + 1)
            .Cells(Ligne, "C") = tablo(i + 2)
            Ligne = Ligne + 1
        Next i
    End With
Fin:
    Application.ScreenUpdating = True
End Sub

Les données sont en feuille 1, le résultat en feuille 2.

Bonjour Sylvanu,
merci pour le retour.
Bien noté, je joins un fichier exemple.
Je vais essayer de comprendre puis de lancer le code que vous m'avez partagé.
Merci.
Bien cordialement ,
Kmanu

KManu · 10 Novembre 2021

Yeahou à dit:
Re,
On dirait des données déjà importées et (mal) transformées, vous n'avez pas un fichier brut d'export en txt ou csv ?
Ce serait plus simple de partir directement de la source

Re,
je joins un fichier txt.

Justement, la désorganisation des données est déjà présente sur le fichier brute.
Pour avoir les données de mon capteur j'ai écris un code sur l'hyperTerminal de mon PC, code qui pars chercher les données voulues
( en fait le capteur ne fais que lire la mesure sans faire migrer les données vers un outils numérique).

Bien cordialement
KManu

KManu · 10 Novembre 2021

sylvanu à dit:

Bonjour Kmanu et bienvenu sur XLD,
Essayez toujours de fournir un fichier test, c'est plus simple, plus parlant, et permet de faire un VBA mieux ciblé. 🙂
En PJ un essai avec :

VB:

Sub Transfert()
    Dim i%, Ligne%, Chaine$, tablo
    Application.ScreenUpdating = False
    On Error GoTo Fin
    ' On concatène toutes les données en une seule chaine
    For i = 1 To Sheets("Feuil1").Range("A65500").End(xlUp).Row
        Chaine = Chaine & Sheets("Feuil1").Cells(i, "A")
    Next i
    ' On splite cette chaine avec la virgule comme séparateur
    tablo = Split(Chaine, ",")
    Ligne = 1
    With Feuil2
        ' On efface la feuille 2
        .Range("A:C").ClearContents
        ' On redistribue les données
        For i = 1 To UBound(tablo) Step 3
            .Cells(Ligne, "A") = tablo(i)
            .Cells(Ligne, "B") = tablo(i + 1)
            .Cells(Ligne, "C") = tablo(i + 2)
            Ligne = Ligne + 1
        Next i
    End With
Fin:
    Application.ScreenUpdating = True
End Sub

Les données sont en feuille 1, le résultat en feuille 2.

Re Sylvanu,

Merci encore!!
le code fonctionne très bien! (il demande juste que les données soient brutes, pas convertion préalable sur Excel).
J'avais une question de compréhension par contre: le "UBound" j'ai du al a bien saisir sa fonction

Bien Cordialement
KManu

KManu · 10 Novembre 2021

Re,
Merci à tous! Eureka.
particulièrement à Sylvanu et Yeahou.
Cordialement,

sylvanu · 10 Novembre 2021

Ubound donne la taille de l'array.
Donc la, on parcourt l'array du premier au dernier élément.

Bernard_XLD · 10 Novembre 2021

Re, bonjour sylvanu

Comme c'est fait, je poste ma proposition.
Lancer la macro par le bouton (ou directement) et choisir le fichier à importer

Bien cordialement, @+

VB:

Sub Import_donnees()
    Dim Tablo, Tablo2$, Tablo3$(), x&, y&, z&, i&, Nom_Fichier$
    With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Lire"
        .AllowMultiSelect = False
        .Title = "Choisissez le fichier à importer"
        .Filters.Clear
        .Filters.Add "Extraction données", "*.txt; *.txt", 1
        .Show
        If .SelectedItems.Count > 0 Then
            Nom_Fichier = .SelectedItems(1)
        Else
            MsgBox "Aucun fichier sélectionné", vbOKOnly + vbInformation, "Information"
            Exit Sub
        End If
    End With
    Workbooks.OpenText Filename:=Nom_Fichier, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(4, _
        9), Array(14, 2)), TrailingMinusNumbers:=True
    Columns("B:B").Replace What:="OK", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula
    Tablo = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value2
    y = LBound(Tablo): z = UBound(Tablo)
    For x = y To z
        If (InStr(1, Tablo(x, 1), ",") > 0 Or InStr(1, Tablo(x, 1), ".") > 0 Or IsNumeric(Tablo(x, 1))) And (IsNumeric(Left(Tablo(x, 1), 1)) Or Left(Tablo(x, 1), 1) = "." Or Left(Tablo(x, 1), 1) = ",") Then
            Tablo2 = Tablo2 & Tablo(x, 1)
        End If
        If Not Tablo2 = "" Then If Left(Tablo(x, 1), 1) = "P" And IsNumeric(Mid(Tablo(x, 1), 2, 1)) Then Tablo2 = Tablo2 & ","
    Next x
    Columns("A:B").ClearContents
    Columns("A:C").NumberFormat = "@"
    Tablo = Split(Tablo2, ",")
    ReDim Tablo3(1 To Application.WorksheetFunction.RoundUp((UBound(Tablo) - LBound(Tablo) + 1) / 3, 0), 1 To 3)
    i = LBound(Tablo)
    For x = LBound(Tablo) To UBound(Tablo) Step 3
        i = i + 1
        Tablo3(i, 1) = Tablo(x)
        Tablo3(i, 2) = Tablo(x + 1)
        Tablo3(i, 3) = Tablo(x + 2)
    Next x
    Range("A1:C" & UBound(Tablo3, 1)).Value2 = Tablo3
End Sub

KManu · 10 Novembre 2021

sylvanu à dit:
Ubound donne la taille de l'array.
Donc la, on parcourt l'array du premier au dernier élément.

Okay, je vois
Merci!

KManu · 10 Novembre 2021

Yeahou à dit:

Re, bonjour sylvanu

Comme c'est fait, je poste ma proposition.
Lancer la macro par le bouton (ou directement) et choisir le fichier à importer

Bien cordialement, @+

VB:

Sub Import_donnees()
    Dim Tablo, Tablo2$, Tablo3$(), x&, y&, z&, i&, Nom_Fichier$
    With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Lire"
        .AllowMultiSelect = False
        .Title = "Choisissez le fichier à importer"
        .Filters.Clear
        .Filters.Add "Extraction données", "*.txt; *.txt", 1
        .Show
        If .SelectedItems.Count > 0 Then
            Nom_Fichier = .SelectedItems(1)
        Else
            MsgBox "Aucun fichier sélectionné", vbOKOnly + vbInformation, "Information"
            Exit Sub
        End If
    End With
    Workbooks.OpenText Filename:=Nom_Fichier, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(4, _
        9), Array(14, 2)), TrailingMinusNumbers:=True
    Columns("B:B").Replace What:="OK", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula
    Tablo = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value2
    y = LBound(Tablo): z = UBound(Tablo)
    For x = y To z
        If (InStr(1, Tablo(x, 1), ",") > 0 Or InStr(1, Tablo(x, 1), ".") > 0 Or IsNumeric(Tablo(x, 1))) And (IsNumeric(Left(Tablo(x, 1), 1)) Or Left(Tablo(x, 1), 1) = "." Or Left(Tablo(x, 1), 1) = ",") Then
            Tablo2 = Tablo2 & Tablo(x, 1)
        End If
        If Not Tablo2 = "" Then If Left(Tablo(x, 1), 1) = "P" And IsNumeric(Mid(Tablo(x, 1), 2, 1)) Then Tablo2 = Tablo2 & ","
    Next x
    Columns("A:B").ClearContents
    Columns("A:C").NumberFormat = "@"
    Tablo = Split(Tablo2, ",")
    ReDim Tablo3(1 To Application.WorksheetFunction.RoundUp((UBound(Tablo) - LBound(Tablo) + 1) / 3, 0), 1 To 3)
    i = LBound(Tablo)
    For x = LBound(Tablo) To UBound(Tablo) Step 3
        i = i + 1
        Tablo3(i, 1) = Tablo(x)
        Tablo3(i, 2) = Tablo(x + 1)
        Tablo3(i, 3) = Tablo(x + 2)
    Next x
    Range("A1:C" & UBound(Tablo3, 1)).Value2 = Tablo3
End Sub

Merci bcp Yeahou!!!
je relis ça en détails .
Bien Cordialement ,

Bernard_XLD · 10 Novembre 2021

re,

Code modifié, un peu plus rapide

Cordialement, @+

VB:

Sub Import_donnees()
    Dim Tablo, Tablo2$, Tablo3$(), Val_Tab$, x&, y&, z&, i&, Nom_Fichier$
    With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Lire"
        .AllowMultiSelect = False
        .Title = "Choisissez le fichier à importer"
        .Filters.Clear
        .Filters.Add "Extraction données", "*.txt; *.txt", 1
        .Show
        If .SelectedItems.Count > 0 Then
            Nom_Fichier = .SelectedItems(1)
        Else
            MsgBox "Aucun fichier sélectionné", vbOKOnly + vbInformation, "Information"
            Exit Sub
        End If
    End With
    Workbooks.OpenText Filename:=Nom_Fichier, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(4, _
        9), Array(14, 2)), TrailingMinusNumbers:=True
    Columns("B:B").Replace What:="OK", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula
    Tablo = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value2
    y = LBound(Tablo): z = UBound(Tablo)
    For x = y To z
        Val_Tab = Left(Tablo(x, 1), 1)
        If InStr(1, Tablo(x, 1), ".") > 0 Or InStr(1, Tablo(x, 1), ",") > 0 Then
            If IsNumeric(Val_Tab) Or Val_Tab = "." Or Val_Tab = "," Then
                Tablo2 = Tablo2 & Tablo(x, 1)
            End If
        End If
        If Not Tablo2 = "" Then
            If Val_Tab = "P" Then
                If IsNumeric(Mid(Tablo(x, 1), 2, 1)) Then Tablo2 = Tablo2 & ","
            End If
        End If
    Next x
    Columns("A:B").ClearContents
    Columns("A:C").NumberFormat = "@"
    Tablo = Split(Tablo2, ",")
    ReDim Tablo3(1 To Application.WorksheetFunction.RoundUp((UBound(Tablo) - LBound(Tablo) + 1) / 3, 0), 1 To 3)
    i = LBound(Tablo)
    For x = LBound(Tablo) To UBound(Tablo) Step 3
        i = i + 1
        Tablo3(i, 1) = Tablo(x)
        Tablo3(i, 2) = Tablo(x + 1)
        Tablo3(i, 3) = Tablo(x + 2)
    Next x
    Range("A1:C" & UBound(Tablo3, 1)).Value2 = Tablo3
End Sub

KManu · 15 Novembre 2021

Bonjour Yeahou!
bien reçu,
merci bcp et bon début de semaine!
Cdlt

Autres Organiser des données sur VBA

KManu

XLDnaute Nouveau

Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

KManu

XLDnaute Nouveau

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

KManu

XLDnaute Nouveau

KManu

XLDnaute Nouveau

Pièces jointes

KManu

XLDnaute Nouveau

KManu

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

KManu

XLDnaute Nouveau

KManu

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

KManu

XLDnaute Nouveau

Discussions similaires

Autres Organiser des données sur VBA

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency