Macro
Résolu
Mark
-
Marrk Messages postés 2 Statut Membre -
Marrk Messages postés 2 Statut Membre -
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.
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.
A voir également:
- Macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Macro maker - Télécharger - Divers Utilitaires
- Macro word - Guide
6 réponses
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...
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
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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 :
Cordialement,
Franck P
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
