Attribuer la valeur "inconnue" à une cellule vide

Résolu
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention   -  
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour tout le monde,

J'ai une base de données de 6 colonnes dans laquelle j'aimerai attribuer la valeur "Inconnue" à toutes les cellules vide.


Je souhaite le réaliser avec le vba sachant que je découvre l'environnement vba.


Merci par avance.

14 réponses

Réponse 1 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Peut être tout simplement comme ceci : 

Dim dl As Long
dl = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:F" & dl).Cells.SpecialCells(xlCellTypeBlanks).Value = "Inconnue"
0
Réponse 2 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour à tous,

pijaku, j'ai appliqué ton code mais ça beug à la dernière ligne en indiquant qu'il y a une erreur d'exécution 1024: la méthode Range de l'objet _Global a échoué.

Quant au code de Thau Thema, je suppose qu'il faut au préalable déclarer une variable.
0
Réponse 3 / 14
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Bonjour le fil, bonjour le forum,

Non, pas besoin de déclarer (ni donc de définir) de variable. Il suffit juste que tu remplaces Ton_onglet par le nom de l'onglet dont il est question...
0
Réponse 4 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Désolée, je suis très limitée en vba.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,
Bienvenu à ThauTheme sur les forums CCM,

Je m'étonne de l'erreur 1024...
Dans quoi as tu placé la procédure donnée?

0
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Merci Franck pour l'accueil !

ThauTheme
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
De rien.
Si tu as la moindre question/difficulté, n'hésite pas à me contacter en MP (clic sur mon pseudo à n'importe qu'elle réponse puis Lui écrire un message).
Bonne continuation.
A+
0
Réponse 6 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Merci beaucoup de votre disponibilité,

Voici le code, il est très long: en fait, je souhaite attribuer la valeur "Inconnue" aux données manquantes avant de procéder à ma stratification. Ceci correspond à mon 1er code comme mentionné ci-dessous.

Thanks! 





Sub EchantillonStratifié()
'
'  Créée par Henry AUBERT le 26/02/1996
'  Dernière mise à jour le 09/03/2000
'
'  Sélectionner dans une feuille contenant des "données brutes", c'est-à-dire
'  un tableau d'observations avec
'     les individus en lignes et
'     les variables en colonnes, avec leurs libellés en ligne 1
'  et le libellé de la variable servant de stratification.
'  Lancer la macro.
'
'  La macro :
'  a) Vérifie la sélection :
'     *  d'une cellule de la première ligne
'     *  avec un libellé,
'     *  et sans données manquantes.
'  b) Demande la taille de l'échantillon, avec, par défaut le sondage au 10ème.
'     Cette taille est contrôlée, et doit, évidemment, être inférieure à celle de la population
'  c) Trie les données selon les valeurs de la variable de stratification,
'  d) Place dans une feuille "Stratification" (créée ou remplacée si elle existait déjà)
'     les noms, tailles, débuts, fins des strates et les effectifs prélevés
'  e) Place dans une feuille "Echantillon" (créée ou remplacée si elle existait déjà)
'     un échantillon "représentatif" au hasard sans remise.
'     Les effectifs des échantillons des strates sont arrondis :
'     Il peut y avoir plus ou moins d'individus dans l'échantillon
'     que le nombre demandé.
'  f) Note dans la feuille des données brutes
'     les "individus" qui ont été sélectionnés dans l'échantillon



      Sheets("DONNEES").UsedRange.SpecialCells(xlCellTypeBlanks).Value = "INCONNU"


      Dim row As Long
      
'
   Application.ScreenUpdating = False
   Bandeau = "Tirage au hasard d'un échantillon stratifié représentatif " & Signature
   MessageDerreur = "Une erreur indéterminée s'est produite !"
   Message = MessageDerreur
   On Error GoTo erreur
'
   Message = "Sélectionnez (ligne 1) le libellé de la variable de stratification !"
   If Selection.row <> 1 _
   Or Selection.Cells.Count > 1 _
   Or Selection.Value = Empty Then GoTo erreur
'
'  Sauvegarde la stratification demandée :
   Set VarStrate = Selection
'
'  Compte le nombre de variables, et supprime la colonne dont l'en-tête serait "dans l'éch"
'
   NbVar = 0
   While NbVar < 255 And Not IsEmpty(Cells(1, NbVar + 1))
      If Cells(1, NbVar + 1) = "dans l'éch" Then
         Cells(1, NbVar + 1).Select
         Message = "Déprotégez la feuille !"
         Selection.EntireColumn.Delete
         ActiveWorkbook.Save
         Message = MessageDerreur
      Else
         NbVar = NbVar + 1
      End If
   Wend
'
   On Error GoTo 0
   Selection.SpecialCells(xlLastCell).Select
'
   Message = "Données manquantes pour cette variable !"
   If Application.CountBlank(Range(Cells(2, VarStrate.Column), Cells(ActiveCell.row, VarStrate.Column))) > 0 Then GoTo erreur
   Message = MessageDerreur
'
   NomVarStrate = VarStrate.Value
   NomFeuillePop = ActiveSheet.Name
'
'  Trie toutes les données selon la colonne sélectionnée :
'
   Range("A1").Select
   Selection.Sort Key1:=Range(VarStrate.Address), Order1:=xlAscending, Header:= _
      xlGuess, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
   VarStrate.Select
'
   row = VarStrate.row                                                 ' son numéro de ligne
   While Not IsEmpty(Cells(row + 1, VarStrate.Column))
      row = row + 1
   Wend
   Range(Cells(VarStrate.row + 1, VarStrate.Column).Address(), Cells(row, VarStrate.Column).Address()).Select
   TaillePop = Selection.Cells.Count
'
   Dim NomStrate()
   Dim DébutStrate()
   Dim TailleStrate()
   Dim FinStrate()
   Dim EchStrate()
'
   NbStrates = 1
   ReDim Preserve NomStrate(NbStrates)
   ReDim Preserve DébutStrate(NbStrates)
   ReDim Preserve TailleStrate(NbStrates)
   ReDim Preserve FinStrate(NbStrates)
   DébutStrate(NbStrates) = 2
   NomStrate(NbStrates) = ActiveCell.Value
   TailleStrate(NbStrates) = 0
   For Each Individu In Selection
      If Individu.Value <> NomStrate(NbStrates) Then
         FinStrate(NbStrates) = Individu.row - 1
         NbStrates = NbStrates + 1
         ReDim Preserve NomStrate(NbStrates)
         ReDim Preserve DébutStrate(NbStrates)
         ReDim Preserve TailleStrate(NbStrates)
         ReDim Preserve FinStrate(NbStrates)
         NomStrate(NbStrates) = Individu.Value
         TailleStrate(NbStrates) = 1
         DébutStrate(NbStrates) = Individu.row
      Else
         TailleStrate(NbStrates) = TailleStrate(NbStrates) + 1
      End If
   Next
   FinStrate(NbStrates) = FinStrate(NbStrates - 1) + TailleStrate(NbStrates)
'
   Header = "Entrez la taille de l'échantillon (maxi "
   Dim TaillEch As Integer
SaisTaille:
   On Error GoTo 0
   TaillEch = TaillePop * 0.007
  ' TaillEch = Val(InputBox(Header & TaillePop & ")" _
  '            & Chr(10) & Chr(10) & "(0 = Annuler)", _
  '             Bandeau, Str(Int(TailleProposée))))
   If TaillEch = 0 Then
      VarStrate.Select
      End
   End If
   If TaillEch < 1 Or TaillEch > TaillePop Then
      Beep
ErrTaille:
      Décision = MsgBox("Valeur erronnée ! Voulez-vous recommencer ?", 4, Bandeau)
      If Décision = vbYes Then GoTo SaisTaille
      If Décision = vbNo Then
        VarStrate.Select
        End
      End If
   End If
'   On Error GoTo 0

'
' Calcul et affichage des éléments de stratification
'
   ReDim EchStrate(NbStrates)
   Total = 0
   For i = 1 To NbStrates
      EchStrate(i) = Application.Round(TailleStrate(i) * TaillEch / TaillePop, 0)
      If EchStrate(i) < 1 Then
         Message = "Attention la strate n°" & i _
         & " (= " & NomStrate(i) & ")" _
         & " de '" & VarStrate & "'" _
         & " ne sera pas représentée." _
         & Chr(13) _
         & "Il faudrait un échantillon de " _
         & Application.RoundUp(TaillePop / TailleStrate(i), 0) _
         & Chr(13) & "Voulez vous abandonner, réessayer une autre taille, ou continuer ?"
         Réponse = MsgBox(Message, vbAbortRetryIgnore, Bandeau)
         If Réponse = vbRetry Then GoTo SaisTaille
         If Réponse = vbAbort Then
            VarStrate.Select
            End
         End If
      End If
      Total = Total + EchStrate(i)
   Next
   For i_feuille = 1 To Sheets.Count
      If Sheets(i_feuille).Name = "Stratification" Then
         Sheets(i_feuille).Delete
      End If
   Next
   Sheets.Add
   ActiveSheet.Name = "Stratification"
'
   Cells(1, 1) = "Strate"
   Cells(1, 2) = "Taille"
   Cells(1, 3) = "Ligne début"
   Cells(1, 4) = "Ligne fin"
   Cells(1, 5) = "Nb d'éch."
   For iLigne = 1 To NbStrates
      Cells(iLigne + 1, 1) = NomVarStrate + " = " & NomStrate(iLigne)
      Cells(iLigne + 1, 2) = TailleStrate(iLigne)
      Cells(iLigne + 1, 3) = DébutStrate(iLigne)
      Cells(iLigne + 1, 4) = FinStrate(iLigne)
      Cells(iLigne + 1, 5) = EchStrate(iLigne)
   Next
   Cells(NbStrates + 2, 1) = "Total :"
   Cells(NbStrates + 2, 1).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 2) = TaillePop
   Cells(NbStrates + 2, 4) = "Total :"
   Cells(NbStrates + 2, 4).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 5) = Total
   Range(Cells(1, 1), Cells(1, 5)).Select
   With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlBottom
      .WrapText = False
      .Orientation = xlHorizontal
      .Font.ColorIndex = 45
      .Interior.ColorIndex = 35
   End With
   Range(Cells(1, 1), Cells(NbStrates + 2, 5)).Columns.AutoFit
   Cells(1, 1).Select
'
'  Prépare feuille Echantillon
'
   For i_feuille = 1 To Sheets.Count
      If Sheets(i_feuille).Name = "Echantillon" Then
         Sheets(i_feuille).Delete
      End If
   Next
   Sheets.Add
   ActiveSheet.Name = "Echantillon"
'
' recopier les en-têtes dans la feuille échantillon
'
   Sheets(NomFeuillePop).Select
   Range(Cells(1, 1), Cells(1, NbVar)).Select
   Application.CutCopyMode = False
   Selection.Copy
   Sheets("Echantillon").Select
   Range("A1").Select
   ActiveSheet.Paste
'
'  Prélèvement et affichage de l'échantillon
'
   ' prépare colonne marquage individus sélectionnés dans feuille données brutes
   Sheets(NomFeuillePop).Select
   Cells(1, NbVar + 1).Value = "dans l'éch"
   Range(Cells(1, NbVar + 1), Cells(TaillePop + 1, NbVar + 1)).Select
   With Selection
      .HorizontalAlignment = xlCenter
      .Font.ColorIndex = 22
   End With
'
   NumLigne = 2
   For istrate = 1 To NbStrates
      iéch = 1
      While iéch < EchStrate(istrate) + 1
         Randomize ' Initialise le générateur de nombres aléatoires avec l'horloge système
         LignAuHasard = Int((FinStrate(istrate) - DébutStrate(istrate) + 2) * Rnd + DébutStrate(istrate))
         If Sheets(NomFeuillePop).Cells(LignAuHasard, NbVar + 1).Value = Empty Then
            Sheets(NomFeuillePop).Range(Cells(LignAuHasard, 1), Cells(LignAuHasard, NbVar)).Copy
            Sheets("Echantillon").Paste Destination:=Sheets("Echantillon").Cells(NumLigne, 1)
            NumLigne = NumLigne + 1
            Sheets(NomFeuillePop).Cells(LignAuHasard, NbVar + 1).Value = "*"
            iéch = iéch + 1
         End If
      Wend
   Next
    Sheets(NomFeuillePop).Cells(1, NbVar + 1).Select
   Sheets("Echantillon").Select
   ActiveSheet.Range("A1").Select
   Application.Calculate
   GoTo Fin
erreur:
   Beep
   Réponse = MsgBox(Message, , Bandeau)
Fin:
   Application.ScreenUpdating = True
End Sub
0
Réponse 7 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Merci du fond du coeur,

ça marche super bien!
0
Réponse 8 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Voici un extrait de résultat de la feuille stratification

Strate Taille Ligne début Ligne fin Nb d'éch.
parking = 0 34 2 35 2
parking = 1 48 36 83 4
Total : 82 Total : 6


Comme vous le constatez, j'adapte ce code à ma problématique.
J'aimerai introduire dans ma macro, un code qui calcule le poids (pourcentage) de chaque strate par rapport à la taille totale. Puis, faire le même calcul pour l'échantillon. Ceci permettra de vérifier si la macro répond à mon objectif.


Pourrez-vous me proposer des codes s'il vous plait?

Merci.
0
Réponse 9 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Bon...
Tu dis : sachant que je découvre l'environnement vba.

Puis tu nous balances une macro longue Comme Mon Bras, avec pour mission de coder une fonction. Ok. Mais...

1- Est ce que tu comprends le code de la macro?

2- Un extrait réel (sous la forme d'une feuille Excel) de tes données + 1 extrait réel du résultat souhaité seraient grandement utiles...

3- Ta macro, je ne l'ai pas lu en entier car dès le début il y a des erreurs. Variables non déclarées, variables inutiles... Elle est donc à revoir dans sa globalité.

Donc...
En attente d'un fichier pour nous pouvoir travailler.
Ok avec mon analyse ThauTheme?

ps :
Pour transmettre un fichier, il faut passer par un site de pièce jointe tel que cjoint.com

Va sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
0
Réponse 10 / 14
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Merci les gars, je suis surtout contente parce que ça avance.

Pijaku, c'est cool ton truc, ça marche!

https://www.cjoint.com/?DJxj7wHtk20 : fichier excel de départ avec résultat

https://www.cjoint.com/?DJxj7wHtk20 : fichier word: macro modifiée pour adapter à mes besoin

J'ai déniché cette macro sur le net parce qu'elle répond à ma problématique. Actuellement je suis en train de l'adapter à la mission qui m'a été confiée en entreprise.


J'ai acheté deux livres sur vba, j'ai vraiment envie de connaître programmer sur vba.

Le code sur les cellules vide me permettent de traiter les valeurs manquantes de ma base de données

La macro initiale m'impose de proposer une taille d'échantillon avant extraction, ce qui ne répond pas à mes attentes: j'ai demandé de me prélever une proportion sur la population totale et dans ce cas c'est la macro qui me donne la taille de l'échantillon.


Ce que je souhaite faire: introduire dans la macro un code qui procède au calcul correspondant aux colonnes Part(%) de l'onglet stratification.

Suis-je explicite?

Merci.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
1- pas de fichier Word. Tu nous as mis deux fois le même lien...

2- pour passer de tes données :

à ton résultat :

Pas besoin d'une macro comme celle dont tu disposes...
Ou alors il y a un truc que je n'ai pas saisi.

3- à quoi correspond la colonne : Nb d'éch. dans les résultats?

4- la colonne parking, dans tes données, est-elle toujours triée dans l'ordre croissant?
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
désolée, voici le fichier word

https://www.cjoint.com/?DJxlKROUfSv

La feuille Stratification et Echantillon correspondent aux résultats de la macro
Nb d'éch correspond au nb de parking dans l'échantillon.

En fait, le but de la macro est de réaliser une extraction aléatoire dans la feuille "donnees"
La macro crée 2 feuilles: "stratification" et "Echantillon" (ensemble d'individus prélevés dans la population totale).
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bon.
Pour faire simple, très simple...
Dans ta feuille Stratification, tu n'auras toujours que une ligne d'entête, deux lignes de données et une ligne "totaux"?
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Dan ma feuille stratification, j'aurai:
une ligne d'entête
plusieurs ligne de données (strate) et
une ligne "totaux"
0
Réponse 11 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Donc.
Ajoute cette Sub, sous ton code existant, après le End Sub de l'autre macro bien sur! 

'!!!!!!!!!!!!!!!!!!!!!!!!!
'ne pas copier ces lignes, il s'agit de la fin de ta macro !!!!!!!!!!!!
   Réponse = MsgBox(Message, , Bandeau)
Fin:
   Application.ScreenUpdating = True
End Sub
'recopier à partir d'ici :

Sub Calcule_Part()
Dim dl As Long, Lig As Long

With Sheets("Stratification")
  dl = .Range("A" & Rows.Count).End(xlUp).Row - 1
  For Lig = 2 To dl
    .Range("C" & Lig).Value = CLng(.Range("C" & Lig).Value) * 100 / CLng(.Range("B" & dl + 1).Value)
    .Range("G" & Lig).Value = CLng(.Range("F" & Lig).Value) * 100 / CLng(.Range("F" & dl + 1).Value)
  Next Lig
End With
End Sub



Et tu appelles cette procédure, depuis ton code principal, à cet endroit : 


'NE RECOPIE PAS CES LIGNES
   Cells(NbStrates + 2, 1) = "Total :"
   Cells(NbStrates + 2, 1).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 2) = TaillePop
   Cells(NbStrates + 2, 4) = "Total :"
   Cells(NbStrates + 2, 4).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 5) = Total
'SEULEMENT CELLE-CI :

   Call  Calcule_Part

'FIN DE LA COPIE!!!
   Range(Cells(1, 1), Cells(1, 5)).Select
   With Selection


🎼 Cordialement,
Franck 🎶
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
dois-je juste copier-coller ces codes à la suite de mon programme?
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
j'ai tout copier et coller à la suite de mon programme et on m'indique qu'un End with est attendu.

Peut être ai-je mal inséré ton code?
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Tu le fais exprès???
Regardes les commentaires que j'ai mis dans le code...
J'ai ajouté des lignes issues de TA macro pour que tu vois bien ou insérer les lignes...

Il manquait toutefois un End With. Je te l'ai ajouté.
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Je ne le fais pas exprès,quel serai l'intérêt?
j'ai bien respecté tes consignes mais la macro beug sur cette ligne:

Range("C" & Lig).Value = CLng(.Range("C" & Lig).Value) * 100 / CLng(.Range("B" & dl + 1).Value)


Voici le lien pour le code modifié: https://www.cjoint.com/?DJxlKROUfSv

Merci
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
je crois avoir compris pourquoi ça beug à ce niveau: dans le tableau résultat que je t'ai présenté plus haut, les colonne où il faut calculer les part (%) ont été inscrites à la main.
0
Réponse 12 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bon.
Excuse moi, j'ai du tout relire pour comprendre...

Voici ton code,
- j'ai indiqué les lignes ajoutées en commentaires.
- j'ai indiqué les lignes modifiées en commentaires,
- j'ai indiqué les endroits buggant pendant mes essais et comment enlever le bug. Replacer 
Sheets.Count
par 
Sheets.Count - 1
... 

Sub EchantillonStratifié()
'
'  Créée par Henry AUBERT le 26/02/1996
'  Dernière mise à jour le 09/03/2000
'
'  Sélectionner dans une feuille contenant des "données brutes", c'est-à-dire
'  un tableau d'observations avec
'     les individus en lignes et
'     les variables en colonnes, avec leurs libellés en ligne 1
'  et le libellé de la variable servant de stratification.
'  Lancer la macro.
'
'  La macro :
'  a) Vérifie la sélection :
'     *  d'une cellule de la première ligne
'     *  avec un libellé,
'     *  et sans données manquantes.
'  b) Demande la taille de l'échantillon, avec, par défaut le sondage au 10ème.
'     Cette taille est contrôlée, et doit, évidemment, être inférieure à celle de la population
'  c) Trie les données selon les valeurs de la variable de stratification,
'  d) Place dans une feuille "Stratification" (créée ou remplacée si elle existait déjà)
'     les noms, tailles, débuts, fins des strates et les effectifs prélevés
'  e) Place dans une feuille "Echantillon" (créée ou remplacée si elle existait déjà)
'     un échantillon "représentatif" au hasard sans remise.
'     Les effectifs des échantillons des strates sont arrondis :
'     Il peut y avoir plus ou moins d'individus dans l'échantillon
'     que le nombre demandé.
'  f) Note dans la feuille des données brutes
'     les "individus" qui ont été sélectionnés dans l'échantillon
'
   Application.ScreenUpdating = False
   Bandeau = "Tirage au hasard d'un échantillon stratifié représentatif " & Signature
   MessageDerreur = "Une erreur indéterminée s'est produite !"
   Message = MessageDerreur
   On Error GoTo erreur
'
   Message = "Sélectionnez (ligne 1) le libellé de la variable de stratification !"
   If Selection.Row <> 1 _
   Or Selection.Cells.Count > 1 _
   Or Selection.Value = Empty Then GoTo erreur
'
'  Sauvegarde la stratification demandée :
   Set VarStrate = Selection
'
'  Compte le nombre de variables, et supprime la colonne dont l'en-tête serait "dans l'éch"
'
   NbVar = 0
   While NbVar < 255 And Not IsEmpty(Cells(1, NbVar + 1))
      If Cells(1, NbVar + 1) = "dans l'éch" Then
         Cells(1, NbVar + 1).Select
         Message = "Déprotégez la feuille !"
         Selection.EntireColumn.Delete
         ActiveWorkbook.Save
         Message = MessageDerreur
      Else
         NbVar = NbVar + 1
      End If
   Wend
'
   On Error GoTo 0
   Selection.SpecialCells(xlLastCell).Select
'
   Message = "Données manquantes pour cette variable !"
   If Application.CountBlank(Range(Cells(2, VarStrate.Column), Cells(ActiveCell.Row, VarStrate.Column))) > 0 Then GoTo erreur
   Message = MessageDerreur
'
   NomVarStrate = VarStrate.Value
   NomFeuillePop = ActiveSheet.Name
'
'  Trie toutes les données selon la colonne sélectionnée :
'
   Range("A1").Select
   Selection.Sort Key1:=Range(VarStrate.Address), Order1:=xlAscending, Header:= _
      xlGuess, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
   VarStrate.Select
'
   Row% = VarStrate.Row                                                 ' son numéro de ligne
   While Not IsEmpty(Cells(Row% + 1, VarStrate.Column))
      Row% = Row% + 1
   Wend
   Range(Cells(VarStrate.Row + 1, VarStrate.Column).Address(), Cells(Row%, VarStrate.Column).Address()).Select
   TaillePop = Selection.Cells.Count
'
   Dim NomStrate()
   Dim DébutStrate()
   Dim TailleStrate()
   Dim FinStrate()
   Dim EchStrate()
'
   NbStrates = 1
   ReDim Preserve NomStrate(NbStrates)
   ReDim Preserve DébutStrate(NbStrates)
   ReDim Preserve TailleStrate(NbStrates)
   ReDim Preserve FinStrate(NbStrates)
   DébutStrate(NbStrates) = 2
   NomStrate(NbStrates) = ActiveCell.Value
   TailleStrate(NbStrates) = 0
   For Each Individu In Selection
      If Individu.Value <> NomStrate(NbStrates) Then
         FinStrate(NbStrates) = Individu.Row - 1
         NbStrates = NbStrates + 1
         ReDim Preserve NomStrate(NbStrates)
         ReDim Preserve DébutStrate(NbStrates)
         ReDim Preserve TailleStrate(NbStrates)
         ReDim Preserve FinStrate(NbStrates)
         NomStrate(NbStrates) = Individu.Value
         TailleStrate(NbStrates) = 1
         DébutStrate(NbStrates) = Individu.Row
      Else
         TailleStrate(NbStrates) = TailleStrate(NbStrates) + 1
      End If
   Next
   FinStrate(NbStrates) = FinStrate(NbStrates - 1) + TailleStrate(NbStrates)
'
   Header = "Entrez la taille de l'échantillon (maxi "
   Dim TaillEch As Integer
SaisTaille:
   On Error GoTo 0
   TailleProposée = TaillePop / 10
   TaillEch = Val(InputBox(Header & TaillePop & ")" _
               & Chr(10) & Chr(10) & "(0 = Annuler)", _
               Bandeau, Str(Int(TailleProposée))))
   If TaillEch = 0 Then
      VarStrate.Select
      End
   End If
   If TaillEch < 1 Or TaillEch > TaillePop Then
      Beep
ErrTaille:
      Décision = MsgBox("Valeur erronnée ! Voulez-vous recommencer ?", 4, Bandeau)
      If Décision = vbYes Then GoTo SaisTaille
      If Décision = vbNo Then
        VarStrate.Select
        End
      End If
   End If
'   On Error GoTo 0
'
' Calcul et affichage des éléments de stratification
'
   ReDim EchStrate(NbStrates)
   Total = 0
   For i = 1 To NbStrates
      EchStrate(i) = Application.Round(TailleStrate(i) * TaillEch / TaillePop, 0)
      If EchStrate(i) < 1 Then
         Message = "Attention la strate n°" & i _
         & " (= " & NomStrate(i) & ")" _
         & " de '" & VarStrate & "'" _
         & " ne sera pas représentée." _
         & Chr(13) _
         & "Il faudrait un échantillon de " _
         & Application.RoundUp(TaillePop / TailleStrate(i), 0) _
         & Chr(13) & "Voulez vous abandonner, réessayer une autre taille, ou continuer ?"
         Réponse = MsgBox(Message, vbAbortRetryIgnore, Bandeau)
         If Réponse = vbRetry Then GoTo SaisTaille
         If Réponse = vbAbort Then
            VarStrate.Select
            End
         End If
      End If
      Total = Total + EchStrate(i)
   Next
   For i_feuille = 1 To Sheets.Count '******** SI BUG AJOUTER - 1
      If Sheets(i_feuille).Name = "Stratification" Then
         Sheets(i_feuille).Delete
      End If
   Next
   Sheets.Add
   ActiveSheet.Name = "Stratification"
'
   Cells(1, 1) = "Strate"
   Cells(1, 2) = "Taille"
   Cells(1, 3) = "Part%" ' *********** LIGNE AJOUTEE
   Cells(1, 4) = "Ligne début"
   Cells(1, 5) = "Ligne fin"
   Cells(1, 6) = "Nb d'éch."
   Cells(1, 7) = "Part%" ' *********** LIGNE AJOUTEE
   For iLigne = 1 To NbStrates
      Cells(iLigne + 1, 1) = NomVarStrate + " = " & NomStrate(iLigne)
      Cells(iLigne + 1, 2) = TailleStrate(iLigne)
      Cells(iLigne + 1, 3) = TailleStrate(iLigne) * 100 / TaillePop ' *********** LIGNE AJOUTEE
      Cells(iLigne + 1, 4) = DébutStrate(iLigne)
      Cells(iLigne + 1, 5) = FinStrate(iLigne)
      Cells(iLigne + 1, 6) = EchStrate(iLigne)
      Cells(iLigne + 1, 7) = EchStrate(iLigne) * 100 / Total ' *********** LIGNE AJOUTEE
   Next
   Cells(NbStrates + 2, 1) = "Total :"
   Cells(NbStrates + 2, 1).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 2) = TaillePop
   Cells(NbStrates + 2, 5) = "Total :"
   Cells(NbStrates + 2, 5).HorizontalAlignment = xlRight
   Cells(NbStrates + 2, 6) = Total
   Range(Cells(1, 1), Cells(1, 7)).Select ' *********** LIGNE MODIFIEE
   With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlBottom
      .WrapText = False
      .Orientation = xlHorizontal
      .Font.ColorIndex = 45
      .Interior.ColorIndex = 35
   End With
   Range(Cells(1, 1), Cells(NbStrates + 2, 7)).Columns.AutoFit ' *********** LIGNE MODIFIEE
   Cells(1, 1).Select
'
'  Prépare feuille Echantillon
'
   For i_feuille = 1 To Sheets.Count '******** SI BUG AJOUTER - 1
      If Sheets(i_feuille).Name = "Echantillon" Then
         Sheets(i_feuille).Delete
      End If
   Next
   Sheets.Add
   ActiveSheet.Name = "Echantillon"
'
' recopier les en-têtes dans la feuille échantillon
'
   Sheets(NomFeuillePop).Select
   Range(Cells(1, 1), Cells(1, NbVar)).Select
   Application.CutCopyMode = False
   Selection.Copy
   Sheets("Echantillon").Select
   Range("A1").Select
   ActiveSheet.Paste
'
'  Prélèvement et affichage de l'échantillon
'
   ' prépare colonne marquage individus sélectionnés dans feuille données brutes
   Sheets(NomFeuillePop).Select
   Cells(1, NbVar + 1).Value = "dans l'éch"
   Range(Cells(1, NbVar + 1), Cells(TaillePop + 1, NbVar + 1)).Select
   With Selection
      .HorizontalAlignment = xlCenter
      .Font.ColorIndex = 22
   End With
'
   NumLigne = 2
   For istrate = 1 To NbStrates
      iéch = 1
      While iéch < EchStrate(istrate) + 1
         Randomize ' Initialise le générateur de nombres aléatoires avec l'horloge système
         LignAuHasard = Int((FinStrate(istrate) - DébutStrate(istrate) + 2) * Rnd + DébutStrate(istrate))
         If Sheets(NomFeuillePop).Cells(LignAuHasard, NbVar + 1).Value = Empty Then
            Sheets(NomFeuillePop).Range(Cells(LignAuHasard, 1), Cells(LignAuHasard, NbVar)).Copy
            Sheets("Echantillon").Paste Destination:=Sheets("Echantillon").Cells(NumLigne, 1)
            NumLigne = NumLigne + 1
            Sheets(NomFeuillePop).Cells(LignAuHasard, NbVar + 1).Value = "*"
            iéch = iéch + 1
         End If
      Wend
   Next
    Sheets(NomFeuillePop).Cells(1, NbVar + 1).Select
   Sheets("Echantillon").Select
   ActiveSheet.Range("A1").Select
   Application.Calculate
   GoTo Fin
erreur:
   Beep
   Réponse = MsgBox(Message, , Bandeau)
Fin:
   Application.ScreenUpdating = True
End Sub
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Je viens de tester la macro elle marche!!!!

Cependant, elle ne répond pas à mes attentes. Je pose le problème autrement:

J'ai fais le même travail mais en concaténant au préalable la colonne B "Arrondissement" et la colonne d "Parking". Ceci m'a permis d'avoir en entrée: le nombre de parking pour parking=1 et parking=0 dans chaque arrondissement.

Je souhaite calculer le pourcentage de caque catégorie de parking dans chaque arrondissement.

Exemple: Part (Parking=0 dans le 16è Arrondissement)= Nbre de parking (=0) dans 16è Arron*100/Nbre tootal de parking du 16è Arrondissement.

Est-ce possible de le réaliser? Ci ce n'est pas clair, dis-le moi s'il te plaît.

Sincèrement désolée, j'avoue que je commence à comprendre et j'apprends beaucoup avec toi.

Merci d'être patient,
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Envoie nous le fichier après avoir fait ta concaténation et la macro mise à jour que nous puissions y regarder...
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Comme tu me l'as demandé, j'ai joint le fichier et la macro mise à jour:

https://www.cjoint.com/?DJyj3F7gQHN


Merci.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Tu n'auras affaire qu'avec les 2 choix arrt et parking?
Ou tu peux en avoir d'autres???
Si oui lesquels?
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
les 2 choix Arrt et parking

Pas d'autres
0
Réponse 13 / 14
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Tentative de réponse par l'intermédiaire d'une formule SOMMPROD :
https://www.cjoint.com/?DJyoOGnsRN5

Dis moi
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
J'ai testé sur mon fichier entreprise et il ne fonctionne pas. Voici un extrait des résultats:

% TOTAL % Echant
0,050327126 #DIV/0!
10,16607952 #DIV/0!
2,617010569 #DIV/0!
2,818319074 #DIV/0!
5,837946653 #DIV/0!
0,251635632 #DIV/0!
0,805234021 #DIV/0!
1,157523905 #DIV/0!
0,050327126 #DIV/0!

Merci
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
J'ai testé sur le fichier donné, il fonctionne...
Qu'elles sont les différences entre les fichiers?

De ce que je vois, je penses que ton "échantillonnage" étant trop faible, il n'a pas de résultat et donc divise par 0... Mais sans le vrai fichier je ne peux que supputer...
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
FICHIER CONFIDENTIEL§

Au contraire, mon fichier st très grand et le tient faible.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Je me doute...
MAis essaye avec le fichier que tu as fourni, cela fonctionne impeccablement...
Peut être as tu changé les colonnes?
Les résultats doivent être dans les même colonnes que le fichier que tu m'as fourni...
0
Motes Messages postés 22 Date d'inscription   Statut Membre Dernière intervention  
 
d'accord, j'essaye et je te tiens au courant
0
Réponse 14 / 14
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Bonjour le fil, bonjour le forum,

Si la colonne A contient moins de données que les autres colonnes, ton code Pijaku, ne va pas fonctionner partout
Pour plus d'efficacité je propose : 
Sheets("Ton_onglet").UsedRange.SpecialCells(xlCellTypeBlanks).Value = "inconnu"

ou, bien sûr tu adapteras le nom de Ton_onglet
-1

Discussions similaires

le frigo ne marche pas....
Nemo6456 -
Templier Nocturne -

1 réponse
[EXCEL] - Attribuer une valeur numérique à un mot
Stev28fr -
Stev28fr -

5 réponses
Internat nourriture
shaun37 -
griggo -

4 réponses
[Excel] Attribuer valeur à texte de liste dér
cestbibi -
gbinforme -

6 réponses
Cette valeur ne correspond pas aux restrictions
Sulphide -
Coolmaster -

3 réponses