Attribuer la valeur "inconnue" à une cellule vide

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"

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.

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...

Désolée, je suis très limitée en vba.

Bonjour,
Bienvenu à ThauTheme sur les forums CCM,

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

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

Merci du fond du coeur,

ça marche super bien!

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.

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...

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.

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 🎶

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

Tentative de réponse par l'intermédiaire d'une formule SOMMPROD :
https://www.cjoint.com/?DJyoOGnsRN5

Dis moi

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