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

mikel831 -  

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. mikel831 Auteur

    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
    1. ccm81

      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
      1. danielc0

        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
        1. danielc0

          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