Attribuer la valeur "inconnue" à une cellule vide

Dim dl As Long
dl = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:F" & dl).Cells.SpecialCells(xlCellTypeBlanks).Value = "Inconnue"

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

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

'!!!!!!!!!!!!!!!!!!!!!!!!!
'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

'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 

Sheets.Count

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

Sheets("Ton_onglet").UsedRange.SpecialCells(xlCellTypeBlanks).Value = "inconnu"