Boucle sur plage avec valeurs identiques

  • Initiateur de la discussion Initiateur de la discussion adinnn
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

adinnn

XLDnaute Occasionnel
Bonjour à tous,

j'ai un petit problème avec le code ci-dessous:

voir pièces jointes pour DB.

J'ai un userform qui sert a entrer différentes info et copier dans un fichier excel externe "DB.xlsm".
Si je ne trouve pas la valeur # de serie dans la DB, je copie tous les champs mais lorsque je trouve la valeur #de serie et que la cellule en colonne #7 est vide, je copie seulement certains champs. Jusque là tout est ok.
Le problème est au niveau de la recherche verticale.

Il se peut que la valeur # de série soit plusieurs fois dans le tableau et c'est là que ça bloque. Si la valeur est trouvé et que la colonne # 7 est pleine, on passe à la prochaine recherche et on regarde encore s'il y a une valeur dans colonne7.

On peut y arriver avec une boucle?

En espérant que ce soit clair...

Merci de votre aide


Code:
Private Sub CommandButton1_Click()
Dim L As Integer
Dim look As String
Dim RTF As String
Dim valeur As String
Dim ligne As Long
Dim cell As range
Dim myrange As range

 
serial = Sheets("data").range("B2").value


Set xls_fichier = GetObject("C:\path\DB.xlsm")
xls_fichier.Windows(1).Visible = True

Set myrange = xls_fichier.Sheets("DB").range("B3:b6000")


    xls_fichier.Sheets("DB").Select
    On Error Resume Next
    RTF = Application.WorksheetFunction.VLookup(serial, xls_fichier.Sheets("DB").range("B3:i6000"), 1, False)
    valeur = Application.WorksheetFunction.VLookup(serial, xls_fichier.Sheets("DB").range("B3:i6000"), 7, False) ' valeur date
    ligne = Application.Match(serial, xls_fichier.Sheets("DB").range("B1:b6000"), 0)


If RTF = serial Then 'Si serial trouvé
    If valeur = "" Then 'Si valeur date vide
        With Sheets("DB")
        .range("h" & ligne).value = Date 'Date Est
        .range("g" & ligne).value = UserFormMain.ComboBox3.value 'Solution
        .range("i" & ligne).value = UserFormMain.TextBox2.value  'Comment
        End With
    Else
        With Sheets("DB")
        .range("b" & ligne).value = UserFormMain.TextBox1.value  '#Serie
        .range("c" & ligne).value = UserFormMain.Label2.Caption 'Famille
        .range("d" & ligne).value = UserFormMain.Label8.Caption 'Scanner model
        .range("e" & ligne).value = UserFormMain.ComboBox2.value 'Problème
        If location = "EST" Then
        .range("h" & ligne).value = Date 'Date Est
        Else
        .range("f" & ligne).value = Date 'Date Ouest
        End If
        .range("g" & ligne).value = UserFormMain.ComboBox3.value 'Solution
        .range("i" & ligne).value = UserFormMain.TextBox2.value  'Comment
        End With
    End If
Else
 L = Sheets("DB").range("b65536").End(xlUp).Row + 1

        With Sheets("DB")
        .range("b" & L).value = UserFormMain.TextBox1.value  '#Serie
        .range("c" & L).value = UserFormMain.Label2.Caption 'Famille
        .range("d" & L).value = UserFormMain.Label8.Caption 'Scanner model
        .range("e" & L).value = UserFormMain.ComboBox2.value 'Problème
        If location = "EST" Then
        .range("h" & L).value = Date 'Date Est
        Else
        .range("f" & L).value = Date 'Date Ouest
        End If
        .range("g" & L).value = UserFormMain.ComboBox3.value 'Solution
        .range("i" & L).value = UserFormMain.TextBox2.value  'Comment
        End With

End If


xls_fichier.Save
xls_fichier.Close
Set xls_fichier = Nothing
Unload UserFormMain

End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
562
Réponses
4
Affichages
606
Réponses
2
Affichages
259
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
832
Retour