macro Résolu

Question

Bonjour, 
Voici mon problème:
J'ai des tableaux avec en ligne des numéro d'article et en tête de colonnes des pays, dans le tableau ce sont des pourcentage.
je voudrais pour chaque article, renvoyer le nom des pays pour lesquels le pourcentage n'est pas nul.

Pouvez vous m'aider?
Merci d'avance.



Configuration: Windows 7 / Safari 536.11

pijaku · Answer

Bonjour,
Cette procédure, si la feuille NonNuls n'existe pas, va la créer, si elle existe, son contenu sera effacé, et va y stocker ce que tu suhaites.
Exécution pour 20 000 lignes en 5,15 secondes...

Option Explicit

Sub RenvoieNonNuls()
Dim MaFeuil As Worksheet, DrLig As Long, DrCol As Integer
Dim Donnees(), Col As Integer, Lig As Long, CptCol As Integer
'!!!IMPORTANT :
    '!!!La feuille active DOIT être la feuille qui contient toutes les données
Set MaFeuil = ActiveSheet
'Si dans le classeur, il existe une feuille appelée "NonNuls" Alors
If FeuilleExiste(ThisWorkbook, "NonNuls") Then
    'On supprime tout ce qu'elle contient
    With Sheets("NonNuls")
        .Cells.Clear
    End With
'Si elle n'existe par
Else
    'on la créé
    Sheets.Add
    ActiveSheet.Name = "NonNuls"
End If
With MaFeuil
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    DrCol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Donnees = .Range(.Cells(1, 1), .Cells(DrLig, DrCol))
End With
With Sheets("NonNuls")
    For Lig = LBound(Donnees) + 1 To UBound(Donnees)
        CptCol = 2
        .Cells(Lig - 1, 1) = Donnees(Lig, 1)
        For Col = LBound(Donnees, 2) + 1 To UBound(Donnees, 2)
        'Debug.Print Donnees(Lig, Col) & " " & Lig & " " & Col
            If Donnees(Lig, Col) <> "" Or Donnees(Lig, Col) <> 0 Then
                .Cells(Lig - 1, CptCol) = Donnees(1, Col)
                CptCol = CptCol + 1
            End If
        Next
    Next
End With
End Sub

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function

Mark · Answer

Bonjour,

le programme ne me renvoie pas la bonne donnée, il renvoie toute la première colonne c'est à dire tous les numéro article mais pas les pays.

Mark · Answer

Okok faut sans doute que je m'inscrive pour ajouter un document..

Marrk · Answer

https://www.cjoint.com/?0HdjGV8ITFq

Voila. Merci de votre aide.

pijaku · Answer

Ok ok, une vulgaire erreur Or au lieu de And...
J'ai ajouté un tyest pour éviter d'inscrire "Total général", et ça donne :

Option Explicit

Sub RenvoieNonNuls()
Dim MaFeuil As Worksheet, DrLig As Long, DrCol As Integer
Dim Donnees(), Col As Integer, Lig As Long, CptCol As Integer
'!!!IMPORTANT :
    '!!!La feuille active DOIT être la feuille qui contient toutes les données
Set MaFeuil = ActiveSheet
'Si dans le classeur, il existe une feuille appelée "NonNuls" Alors
If FeuilleExiste(ThisWorkbook, "NonNuls") Then
    'On supprime tout ce qu'elle contient
    With Sheets("NonNuls")
        .Cells.Clear
    End With
'Si elle n'existe par
Else
    'on la créé
    Sheets.Add
    ActiveSheet.Name = "NonNuls"
End If
With MaFeuil
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    DrCol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Donnees = .Range(.Cells(1, 1), .Cells(DrLig, DrCol))
End With
With Sheets("NonNuls")
    For Lig = LBound(Donnees) + 1 To UBound(Donnees)
        CptCol = 2
        .Cells(Lig - 1, 1) = Donnees(Lig, 1)
        For Col = LBound(Donnees, 2) + 1 To UBound(Donnees, 2)
        Debug.Print Donnees(1, Col)
            If Donnees(Lig, Col) <> "" And Donnees(Lig, Col) <> 0 And Donnees(1, Col) <> "Total général" Then
                .Cells(Lig - 1, CptCol) = Donnees(1, Col)
                CptCol = CptCol + 1
            End If
        Next
    Next
End With
End Sub

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function

--
Cordialement,
Franck P

Marrk · Answer

Ok Parfait!! Merci beaucoup!

Macro

6 réponses

Discussions similaires

Newsletters