XL 2016 [RESOLU]Problème fichier avec USF

[darkjedi]

Bonjour à tous;

Grâce à l'aide de ce forum et d'autres, j'ai pu créer un petit programme pour mon travail alors qu'il y a 3 mois de cela je ne connaissais rien de rien à propos de tout ceci.
Cependant je rencontre divers problèmes qui sont certainement minime mais que je ne réussis pas à résoudre.
Avec votre aide, je suis certain que cela n'en sera plus un.

Problème 1:
J'ai un fichier qui me sert de base de données avec plusieurs onglets.
Dans celui-ci, à partir de l'onglet "ACCUEIL", j'active un USF qui me servira à saisir des données liées entre elles (pays - région - département - code postal - commune) => étape 1 = saisie
Dans celui-ci, à partir de l'onglet "ACCUEIL", j'active un USF qui me permettra de filtrer ma base de données => étape 2 = filtrage

Le code vba me semble lourd.... quelles sont les améliorations possibles en sachant que l'onglet "BD" contient 37000 lignes liées entre elles (pays à commune).
L'onglet "FILTRATION" me permettra la mise en place du géocodage et la création d'un fichier exploitable par google maps. Cela n'est pas encore certain.

Problème 2:
Quand je saisis un numéro d'échantillon colonne A de l'onglet "Moyenne RMN" ou autre pour entrer mon résultat d'anaylse, existe-t-il un moyen pour qu'une vérification se fasse sur la colonne A de l'onglet "DONNEES - RESULTAT" . Ainsi si le numéro saisi n'existe pas il faudrait que celui-ci soit reporté sur la première ligne libre de cet onglet en colonne A. Il en sera de même pour chaque onglet présent où je saisis mes résultats.

Problème 3:
Dans l'USF1, j'aimerai ajouter un bouton de commande qui permettrai la modification d'une ligne de l'onglet "DONNEES - RESULTAT". Ce bouton ouvrira une boite de dialogue où je saisirai le numéro échantillon voulu. Ensuite en validant mon choix, mon USF1 se remplirai avec les données déjà saisi dans cet onglet. Je suis perdu car je n'y arrive pas.

Voici le fichier en question: (il pèse 14 Mo donc impossible de l'intégrer normalement à ma demande.)
FICHIER HEBERGE SUR FREE

Ou bien en version simplifié et allégé ci joint.

Cordialement.

 

[darkjedi]

Re : Problème fichier avec USF

Bonjour à tous,
J'ai trouvé une solution pour mon problème 2 grâce à mes recherches sur ce forum.
J'ai utilisé le dictionnaire et j'ai ajouté ce code pour chaque onglet de mon classeur

Option Explicit
 
Dim sh1 As Variant
Dim sh2 As Variant
Dim c As Variant
Dim MonDico1 As Variant
Dim MonDico2 As Variant
Dim lig As Variant
 
Sub MajListe()
 
  Worksheets("DONNEES - RESULTATS").Unprotect 'userinterfaceonly:=True
  Application.ScreenUpdating = False
 
  Set sh1 = ActiveSheet  'definir feuille active
  Set sh2 = Sheets("DONNEES - RESULTATS") 'definir feuille DONNEES - RESULTATS
 
  '*******************************************
  '*******************************************
  'Dico pour feuille ("DONNEES - RESULTATS")
  '*******************************************
  '*******************************************
 
  Set MonDico1 = CreateObject("scripting.dictionary")
 
  For Each c In sh2.[A2:A10000]
    If c.Value <> "" Then MonDico1(c.Value) = c.Value
  Next c
 
  '*******************************************
  '*******************************************
  'Dico pour feuille active
  '*******************************************
  '*******************************************
 
  Set MonDico2 = CreateObject("scripting.dictionary")
 
  For Each c In sh1.[A2:A10000]
    If c.Value <> "" Then
      If Not MonDico1.exists(c.Value) Then MonDico2(c.Value) = c.Value
    End If
  Next c
 
  '*****************************************
  '*****************************************
  'Ajout des valeurs non presente de la feuille C13 sur ("DONNEES - RESULTATS")
   '*****************************************
  '******************************************
  With Sheets("DONNEES - RESULTATS")
  lig = .[A65536].End(xlUp).Row + 1
 
    If MonDico2.Count > 0 Then
      .Range("A" & lig).Value = Application.Transpose(MonDico2.keys)
    End If
  'If MonDico2.Count > 0 Then
    'MonDico2.[A10000].End(xlUp).Offset(1).Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.keys)
  'End If
  End With
 
  Application.ScreenUpdating = True
  Sheets("DONNEES - RESULTATS").Protect


End Sud

Cependant je n'ai toujours de solution pour mon problème n°3. Je continue mes recherches. Et si vous avez une solution je suis preneur.

 

[darkjedi]

Re : Problème fichier avec USF

Bonjour à tous.
Après moultes recherches, j'ai réussi à régler mon problème n°3
voici le code:

Private Sub Bouton_Correction_Click()

MsgBox ("ATTENTION. Pour éviter tout problème de bogue avant de valider votre saisie dans le formulaire, veuillez vérifier les saisies liées suivantes : commune, code postal, nom département, numéro département, région, pays."), , information


'definir une boite de dialogue
  h = InputBox("Quel numéro d'échantillon voulez-vous corriger?", "Correction échantillon")
  
    If h = "" Then Exit Sub
    
    If h <> "" And Not h Like "####-####" Then
      MsgBox "Veuillez corriger l'identification de l'échantillon (année - ####). Cliquer sur CORRECTION.", , erreur
      h = ""
    End If

      'definir sur quelle feuille on se trouve et la colonne
      With Sheets("DONNEES - RESULTATS").Columns(1)
  
        'definir ce qui est cherché
        Set i = .Find(h)
 
        If Not i Is Nothing Then
            UserForm_Initialize
            TextBox1 = i.Offset(, 0).Value
            TextBox2 = i.Offset(, 1).Value
            TextBox3 = i.Offset(, 3).Value
            TextBox4 = i.Offset(, 13).Value
            TextBox5 = i.Offset(, 8).Value
            ComboBox3 = i.Offset(, 2).Value
            ComboBox5 = i.Offset(, 10).Value
            ComboBox11 = i.Offset(, 11).Value
            ComboBox12 = i.Offset(, 12).Value
            i.EntireRow.Delete Shift:=xlUp
          Else: MsgBox ("Numéro d'échantillon non trouvé. Veuillez recommencer en cliquant sur CORRECTION."), , erreur
          End If

      End With
 
End Sub

Si cela peut servir à d'autres.