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