XL 2013 Macro Complexe pour mise en forme

bibbip35

XLDnaute Occasionnel
Bonjour à tous


J’aurai besoin de votre aide , pour la réalisation d’une Macro Excel si c’est possible bien sur


Je souhaiterais faire une macro , dans le cadre de mon activité professionnelle
Aujourd’hui, nous avons des nomenclatures Excel sous cette forme

Part NUMBER Repère TOPO
R0603 0 ohm R1;R25;R29…R37
R0603 89K R15;R35;R39…R42



Mais pour une activité spécifique , il faudrait une ligne par Repère TOPO
J’aimerais automatiser cette tache qui nous impose aujourd’hui beaucoup de saisie manuel

=>Voir fichier excel en PJ

Aurriez-vous une idée pour generer ce type de Macro

Merci encore a tous pour votre aide

Bibbip
 

Pièces jointes

  • Test.xlsx
    32.7 KB · Affichages: 47

klin89

XLDnaute Accro
Bonjour bibbip35, le forum

Vois ceci :
VB:
Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, e
    With Sheets("Avant").Range("a1").CurrentRegion
        a = .Value
        'attention à la 1ère dimension
        ReDim b(1 To 1000, 1 To UBound(a, 2))
        For i = 1 To UBound(a, 1)
            For Each e In Split(a(i, 2), ";")
                If Trim(e) <> "" Then
                    n = n + 1
                    b(n, 1) = a(i, 1)
                    b(n, 2) = Trim(e)
                End If
            Next
        Next
        With .Offset(, .Columns.Count + 1)
            .CurrentRegion.ClearContents
            .Resize(n, UBound(a, 2)).Value = b
        End With
    End With
End Sub
klin89
 

bibbip35

XLDnaute Occasionnel
Merci pour votre retour
En effet; j'avais bien fait une faute de frappe
Mais maintenant c'est sur ligne With .Offset(, .colums.Count + 1) qu'il y a une nouvelle erreur

Sub test()
Dim a, b(), i As Long, n As Long, e
With Sheets("Avant").Range("A1").CurrentRegion
a = .Value
'Attention à la 1er dimension

ReDim b(1 To 1000, 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
For Each e In Split(a(i, 2), ";")
If Trim(e) <> "" Then
n = n + 1
b(n, 1) = a(i, 1)
b(n, 2) = Trim(e)
End If
Next
Next
With .Offset(, .colums.Count + 1)
.CurrentRegion.ClearContents
.Resize(n, UBound(a, 2)).Value = b
End With
End With
End Sub
 

bibbip35

XLDnaute Occasionnel
Bonjour à tous
Et merci pour ces retours

Mais la macro fonctionne partiellement
Ok avec les séparateur ;
Mais avec l intervalle ... c est ko
L'objectif étant pour par exemple
R0805 0 R1...R4

De générer
R0805 0 R1
R0805 0 R2
R0805 0 R3
R0805 0 R4

Est-ce que quelqu'un aurait une proposition

Merci à tous

Bibbip
 

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088