refaire un code

[aperobass]

salut à tous, j'ai un petit problème.Je veux refaire un code qui à la même fonction.
Ce code sert à chercher les doublons.

valeurAdditionee = Val(Right(TextBox3, 5)) + (ComboBox3 - 1)
TextBox4 = Left(TextBox3, 1) & Application.Rept("0", 5 - Len(valeurAdditionee)) & valeurAdditionee

RefDebut = TextBox3.Value
nbRef = ComboBox3.Value
Set zoneDesRef = Range("B4:B2000,D4: D2000")

For Each cellule In zoneDesRef
For i = 0 To nbRef
numNouvelleRef = Val(Right(RefDebut, 5)) + i
longNum = Len(numNouvelleRef)
refATrouver = Left(RefDebut, 1) & Application.Rept("0", 5 - Len(valeurAdditionee)) & numNouvelleRef
If cellule.Value = refATrouver Then
trouver = "OUI"
Exit For
End If
Next
If trouver = "OUI" Then
Exit For
End If
Next

If trouver = "OUI" Then
MsgBox ("Une référence existante a été trouvée")
Unload sérial

A la place de ce code:
valeurAdditionee = Val(Right(TextBox3, 5)) + (ComboBox3 - 1)
TextBox4 = Left(TextBox3, 1) & Application.Rept("0", 5 - Len(valeurAdditionee)) & valeurAdditionee
Je met ça:
valeurAdditionee = Mid(TextBox3, 1, InStr(TextBox3, "D") - 1)
reste = Mid(TextBox3, InStr(TextBox3, "D"))
valeurAdditionee = valeurAdditionee + Val(ComboBox3)
TextBox4 = Left(mot, Len(mot) - Len(valeurAdditionee)) & valeurAdditionee & reste
Je n'arrive pas à faire la suite ça bloque?
A+

 

[aperobass]

Re : refaire un code

Salut à tous.Je voudrais savoir ce qui va pas dans mon code ?
Quelqu'un pourrais m'aider?

 Private Sub ComboBox3_Change()
     If ComboBox3 = "" Then Exit Sub
     mot = "0000"
    valeurAdditionee = Mid(TextBox3, 1, InStr(TextBox3, "D") - 1)
    reste = Mid(TextBox3, InStr(TextBox3, "D"))
    valeurAdditionee = valeurAdditionee + Val(ComboBox3)
    TextBox4 = Left(mot, Len(mot) - Len(valeurAdditionee)) & valeurAdditionee & reste

      RefDebut = TextBox3.Value
  nbRef = ComboBox3.Value
  Set zoneDesRef = Range("B4:B2000,D4:D2000")
  For Each cellule In zoneDesRef
    For i = 0 To nbRef
        numNouvelleRef = Val(Mid(RefDebut, 1, InStr(TextBox3, "D")) + i)
        longNum = Len(numNouvelleRef)
        refATrouver = Right(RefDebut, 1) & Left(mot, Len(mot) - Len(valeurAdditionee)) & valeurAdditionee & numNouvelleRef & reste
        If cellule.Value = refATrouver Then
            trouver = "OUI"
            Exit For
        End If
    Next
    If trouver = "OUI" Then
        Exit For
    End If
Next

If trouver = "OUI" Then
    MsgBox ("Une référence existante a été trouvée")
    Unload sérial
End If
end sub

A+

 

[Bebere]

Re : refaire un code

bonjour Aperobass

je te met le code changé
change dans la feuille listes(éviter d'afficher des lignes vides dans les combobox)
création d'une fonction pour changer référence
la méthode find est beaucoup plus rapide

'pour changer les onglets avec le combobox1'

Private Sub ComboBox1_Change()

If ComboBox1 = "" Then Exit Sub

If FeuilleExiste(ComboBox1) = True Then
Sheets(Trim(ComboBox1)).Activate
Else
MsgBox "La feuille " & Trim(ComboBox1) & " n'existe pas...", 48
Exit Sub
End If

Me.TextBox3 = Range("D" & Range("D65536").End(xlUp).Row).Text

End Sub


Private Sub ComboBox3_Change()
Dim I As Byte
If ComboBox3 = "" Then Exit Sub

If Not IsNumeric(ComboBox1) Then '= "choisir la référence"
MsgBox "choisir une référence,svp"
ComboBox3 = ""
ComboBox1.SetFocus
Exit Sub
End If

TextBox4 = ChangeRef(TextBox3, 1)
Select Case ActiveSheet.Name

Case Is = "2"
Set ws = Worksheets("2")
Case Is = "4"
Set ws = Worksheets("4")

End Select

Set zoneDesRef = ws.Range("B3:B2000,D32000")

For I = 0 To Val(ComboBox3)
numNouvelleRef = ChangeRef(TextBox3, I)

Compte = 0

With zoneDesRef
Set c = .Find(numNouvelleRef, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Compte = Compte + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

If Compte > 0 Then
MsgBox "Référence " & numNouvelleRef & " trouvée en " & ws.Name & "." & ws.Range(Cells(c.Row), Cells(c.Column)).Address
End If

Next I

End Sub

Function ChangeRef(NewRef As String, Ajout As Byte) As String

mot = "0000"
valeurAdditionee = Mid(NewRef, 1, InStr(NewRef, "T") - 1)
reste = Mid(NewRef, InStr(NewRef, "T"))
valeurAdditionee = valeurAdditionee + Ajout
ChangeRef = Left(mot, Len(mot) - Len(valeurAdditionee)) & valeurAdditionee & reste

End Function

à bientôt

 

[aperobass]

Re : refaire un code

Salut Bebere , Merci de m'avoir aider, c'est cool
A+