XL 2010 Réorganisation de données et Alertes

[fouggy]

Bonjour à tout le Forum,

Je souhaiterais réorganiser les données d'un fichier et créer un système d'alertes.

Si j'ai pu récupérer quelques mini macros sur le Forum afin de les adapter il m'en manque quelque unes dont je ne maîtrise pas l'élaboration.

Et s'il était possible de n'avoir qu'une seule macro pour réaliser l'ensemble de la démarche, cela serait vraiment le top.

Merci de votre aide.

PS : en fichier joint, l'explicatif précis de la démarche

 

[Bebere]

bonjour
fouggy bienvenue
code Arrange dans module 1
à exécuter une fois

 

[fouggy]

Bonjour Bebere et un grand merci pour ton aide précieuse.

Cela marche au top mais il faudrait juste modifier la capacité de traitement des colonnes.

En effet, si j'applique la macro sur un des fichiers que j'ai à traiter, il m'annonce : "Erreur 6" & "Dépassement de capacité" avec en surlignage jaune dans la macro :

nbC = Ws1.Range("B1").End(xlToRight).Column

J'ai alors traité le nombre de colonnes en 3 fois et cela marche effectivement au top.

Aurais-tu l'extrême gentillesse d'apporter la modification nécessaire ?

Enorme merci d'avance.

PS : En fichier joint, l'un des fichiers

 

[Bebere]

bonjour Fouggy tu changes nbc as byte en nbc as long,les autres as byte aussi
byte ne va que jusque 256

 

[fouggy]

Bonjour Bebere,

Ai modifié, Byte en long et là, même message d'erreur : "6" ; "Dépassement de capacité"
mais le problème vient maintenant d'une autre ligne surlignée en jaune :
For C = 1 To UBound(a, 2) ' Step 2

 

[Bebere]

bonjour
Fouggy tu as une erreur parce que la feuille n'existe pas

Public Sub Arrange()
    Dim Ws As Worksheet, Ws1 As Worksheet, L As Long, Li As Long, C As Long, nbC As Long, a(), x As Long, y
    Set Ws1 = Worksheets("Feuil1")
    L = Ws1.Range("b65000").End(xlUp).Row
    nbC = Ws1.Range("B1").End(xlToRight).Column
    a = Ws1.Range("B1:" & Ws1.Cells(2, nbC).Address).Value
    Ws1.Range("B3:" & Ws1.Cells(L, nbC).Address).ClearContents
    L = 0
    For C = 1 To UBound(a, 2)
        L = L + 1
        Ws1.Cells(L, 1).Value = a(1, C)
        Ws1.Cells(L, 2).Value = a(2, C)
    Next C
    Ws1.Range("C1:" & Ws1.Cells(2, nbC).Address).ClearContents
    L = Ws1.Range("A65000").End(xlUp).Row
    a = Ws1.Range("A1:C" & L).Value

    For L = 1 To UBound(a, 1)
        If Not IsError(Evaluate("='" & CStr(a(L, 1)) & "'!A1")) Then    'teste si feuille existe,voir plus bas un autre code
            Set Ws = Worksheets(CStr(a(L, 1)))
            For Li = 1 To 65000
                If Ws.Range("I" & Li) <> "" Then a(L, 3) = Ws.Range("I" & Li): Exit For
            Next Li
        End If
    Next L
    Ws1.Range("A1").Resize(UBound(a, 1), UBound(a, 2)) = a
    x = InputBox("Entrer une valeur,svp")    ' de 2 chiffres

    For L = 1 To UBound(a, 1)
   If IsError(Evaluate("='" & CStr(a(L, 1)) & "'!A1")) = True Then    'teste si feuille existe
   'action.Exemple: msgbox "Feuille" & a(L, 1) & " n'existe pas"'tu supprimes 'action.Exemple: pour avoir le message
   Else
        y = a(L, 2) - a(L, 3)
        If y <= x Then
            Ws1.Cells(L, 3).Interior.ColorIndex = 6
        End If
     End If
    Next

End Sub

 

[fouggy]

Slt Bebere,

Je ne sais quelle feuille n'existait pas, mais en tous les cas ta nouvelle codification fait que cela marche au top...

Super .

Un grand Merci à toi