VBA Excel : Reconstruction de chaînes de caractères

mikel831 Messages postés 237 Date d'inscription   Statut Membre Dernière intervention   -  
mikel831 Messages postés 237 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour à tous !
J'ai deux chaînes de caractères A et D pouvant contenir chacune au maximum  20 nombres entiers  de type Byte:
- A est la chaîne originale
- D est la chaîne pouvant contenir des Doublons de la chaîne A.
Existe t-il une fonction qui reconstruise la chaîne A en supprimant les doublons contenus dans la chaîne D ?


Windows / Chrome 123.0.0.0

4 réponses

  1.
    danielc0 Messages postés 2175 Date d'inscription   Statut Membre Dernière intervention   286
     

    Bonjour,

    Essaie :

    Sub test()
  Dim A, D, TablA As Variant, TablD As Variant, Txt As String
  Dim Ctr As Long, I As Long
  A = "123 456 789 012 345 678"
  D = "123 12 678 123"
  TablA = Split(A, " ")
  TablD = Split(D, " ")
  For Each Item In TablA
    Ctr = 0
    For I = 0 To UBound(TablD)
      If Item = TablD(I) Then Ctr = Ctr + 1
    Next I
      If Ctr < 2 Then
        Txt = Txt & " " & Item
      End If
  Next Item
  A = Right(Txt, Len(Txt) - 1)
End Sub

    Daniel

    0
  2. danielc0 Messages postés 2175 Date d'inscription   Statut Membre Dernière intervention   286
     

    Ou bien :

    Sub test1()
  Dim A, D, TablA As Variant
  Dim Ctr As Long, I As Long
  A = "123 456 789 012 345 678"
  D = "123 12 678 123"
  TablA = Split(A, " ")
  For Each Item In TablA
    If Len(Application.Substitute(D, Item, "")) < Len(D) - Len(Item) Then
      A = Application.Substitute(A, Item, "")
    End If
  Next Item
  Replace A, "  ", " "
End Sub

    Daniel

    0
  3. ccm81 Messages postés 11033 Statut Membre 2 434
     

    Bonkour

    Une autre

    Public Function joindre(s1 As String, s2 As String) As String
Dim dico As Object, cle As String
Dim t1, t2, k As Long
Set dico = CreateObject("scripting.dictionary")
t1 = Split(s1, " ")
t2 = Split(s2, " ")
For k = 0 To UBound(t1)
  cle = t1(k)
  If Not dico.exists(cle) Then dico.Add cle, 1
Next k
For k = 0 To UBound(t2)
  cle = t2(k)
  If Not dico.exists(cle) Then dico.Add cle, 1
Next k
joindre = Join(dico.keys, " ")
End Function

    Cdlmnt

    0
  4. mikel831 Messages postés 237 Date d'inscription   Statut Membre Dernière intervention   19
     

    Merci à tous pour vos réponses!
    J'étais un peu naïf en pensant qu'il existait une fonction simple préexistante ...
    Je vais adapter vos propositions à mon cas particulier.
    Merci pour votre aide, cordialement, Mikel

    0