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

mikel831 Messages postés 220 Date d'inscription   Statut Membre Dernière intervention   -  
mikel831 Messages postés 220 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

A voir également:

4 réponses

Réponse 1 / 4
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   231
 

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
Réponse 2 / 4
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   231
 

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
Réponse 3 / 4
ccm81 Messages postés 10909 Date d'inscription   Statut Membre Dernière intervention   2 433
 

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
Réponse 4 / 4
mikel831 Messages postés 220 Date d'inscription   Statut Membre Dernière intervention   18
 

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