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
 

Fichiers joints

klin89

XLDnaute Impliqué
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
Bonjour Klin89

Merci pour votre réponse rapide Mais quand je lance la macro j'ai une erreur d'incompabilité type 13

Aurriez-vous une idée

Merci

Bibbip35
 

Fichiers joints

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

Est-ce que quelqu'un aurait une proposition

Merci à tous

Bibbip
 

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
 

bibbip35

XLDnaute Occasionnel
Bonjour à tous

Je relance le sujet et mon problème...
Est-ce quelqu'un aurait une suggestion ; une idée ?

Merci a tous et je vous souhaite une joyeux noel

Bibbip35
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas