Boucle sur plage avec valeurs identiques

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

  • DB.xlsm
    13.7 KB · Affichages: 31
  • DB.xlsm
    13.7 KB · Affichages: 34

Statistiques des forums

Discussions
315 108
Messages
2 116 279
Membres
112 711
dernier inscrit
EBEUR