XL 2016 Curiosités numériques et VBA

[garnote]

Bonjour tout monde,

En souvenir de l'époque Excelabo à laquelle j'ai participé pendant quelques années avec mes folies mathématiques!
Que de beaux souvenirs, c'était fantastique! Je pense à Misange, GeeDee, Laurent Longre et bien d'autres joyeux lurons.
Salutations distinguées à tous et toutes qui ont fait mon plaisir. Ci-joint un document sur les nombres de Dudeney!
À votre avis, pourrais-je simplifier la macro nommée Cubes? Et un graphique pour sa beauté!

Aussi une question au sujet des nombres vampires
1260 est un vampire parce qu'il est obtenu par le produit de 21 par 60
2187 est un vampire parce qu'il est obtenu par le produit de 27 par 81
et que chacun contient les mêmes chiffres que les deux nombres multipliés, peut importe l'ordre.

Alors, pour trouver les vampires, il me faudrait une macro permettant de savoir que, par exemple :
1260 contient les mêmes chiffres que 2160
2187 contient les mêmes chiffres que 2781

Donc, comment faire en VBA pour savoir que deux nombres contiennent exactement les mêmes chiffres,
peut importe l'ordre?
Vous avez une idée? J'ai tout tenté en utilisant Mid et InStr, mais sans succès.

Bonne fin de weekend et Vive ce nouvel environnement !

Serge

 

[Jacky67]

Bonjour tout monde,

En souvenir de l'époque Excelabo à laquelle j'ai participé pendant quelques années avec mes folies mathématiques!
Que de beaux souvenirs, c'était fantastique! Je pense à Misange, GeeDee, Laurent Longre et bien d'autres joyeux lurons.
Salutations distinguées à tous et toutes qui ont fait mon plaisir. Ci-joint un document sur les nombres de Dudeney!
À votre avis, pourrais-je simplifier la macro nommée Cubes? Et un graphique pour sa beauté!

Aussi une question au sujet des nombres vampires
1260 est un vampire parce qu'il est obtenu par le produit de 21 par 60
2187 est un vampire parce qu'il est obtenu par le produit de 27 par 81
et que chacun contient les mêmes chiffres que les deux nombres multipliés, peut importe l'ordre.

Alors, pour trouver les vampires, il me faudrait une macro permettant de savoir que, par exemple :
1260 contient les mêmes chiffres que 2160
2187 contient les mêmes chiffres que 2781

Donc, comment faire en VBA pour savoir que deux nombres contiennent exactement les mêmes chiffres,
peut importe l'ordre?
Vous avez une idée? J'ai tout tenté en utilisant Mid et InStr, mais sans succès.

Bonne fin de weekend et Vive ce nouvel environnement !

Serge

Bonjour,
Sans oublier le regretté JPS et tant d'autres
Macro cube allégée

Sub Cubes() '*****nouvelle macro
    For v = 1 To k
        n = Cells(v, 1)
        For i = 1 To Len(n)
            x = x & Mid(n, i, 1) & "+"
        Next i
        Cells(v, 2) = "= (" & Left(x, Len(x) - 1) & ")^3"
        x = ""
    Next v
End Sub

Pour la vérification de 2 nombres, cela pourrait ressembler à cela

Sub Identique()
    Dim C As Range, i&, tmp$
    With Feuil2
        .Columns(3).ClearContents
        For Each C In .Range("a1:a" & .Cells(Rows.Count, "A").End(xlUp).Row)
            If Len(C.Offset(, 1)) > Len(C) Then tmp = C.Offset(, 1): C.Offset(, 1) = C: C = tmp
            For i = 1 To Len(C)
                If InStr(C.Offset(, 1), Mid(C, i, 1)) = 0 Then C.Offset(, 2) = "non conforme": Exit For
            Next
        Next
    End With
End Sub

Exemple en PJ sur une nouvelle feuille
Pour le graphique, je cède la main

 

[garnote]

Bonjour,
Sans oublier le regretté JPS et tant d'autres
Macro cube allégée

Sub Cubes() '*****nouvelle macro
    For v = 1 To k
        n = Cells(v, 1)
        For i = 1 To Len(n)
            x = x & Mid(n, i, 1) & "+"
        Next i
        Cells(v, 2) = "= (" & Left(x, Len(x) - 1) & ")^3"
        x = ""
    Next v
End Sub

Pour la vérification de 2 nombres, cela pourrait ressembler à cela

Sub Identique()
    Dim C As Range, i&
    With Feuil2
        .Columns(3).ClearContents
        For Each C In .Range("a1:a" & .Cells(Rows.Count, "A").End(xlUp).Row)
            For i = 1 To Len(C)
                If InStr(C.Offset(, 1), Mid(C, i, 1)) = 0 Then C.Offset(, 2) = "non conforme": Exit For
            Next
        Next
    End With
End Sub

Exemple en PJ sur une nouvelle feuille
Pour le graphique, je cède la main

Merci infiniment. J'examinerai tout ça très attentivement demain. Bonne journée!

 

[Jacky67]

Merci infiniment. J'examinerai tout ça très attentivement demain. Bonne journée!

Re..
Ligne de code rajoutée en #2 et PJ
Bonne nuit

 

[TooFatBoy]

Bonjour,

Donc, comment faire en VBA pour savoir que deux nombres contiennent exactement les mêmes chiffres,
peut importe l'ordre?
Vous avez une idée? J'ai tout tenté en utilisant Mid et InStr, mais sans succès.

Une proposition sous forme de fonction personnalisée :

Function Vampire(Texte_1, Texte_2)
    Vampire = "Pas vampire"
    If Len(Texte_1) = Len(Texte_2) And Len(Texte_1) > 0 Then
        For x = 1 To Len(Texte_1)
            CarX = Mid(Texte_1, x, 1)
            If InStr(Texte_2, CarX) = 0 Then Exit Function
            Texte_2 = Replace(Texte_2, CarX, "", 1, 1)
        Next x
        Vampire = "V A M P I R E   !"
    End If
End Function

 

[mapomme]

Bonjour à @garnote ,@Jacky67 , @TooFatBoy

Bonjour une petite fonction personnalisée.
On ne distingue pas les nombres positifs des négatifs (le signe n'étant pas un chiffre) .
Si un des arguments n'est pas un entier on retourne une erreur.

Function JaiLesMemes(ByVal n1&, ByVal n2&) As Boolean
Dim s1, s2, i
   s1 = Trim(Abs(n1)): s2 = Trim(Abs(n2))
   If Len(s1) <> Len(s2) Then Exit Function
   For i = 1 To Len(s1): s2 = Replace(s2, Mid(s1, i, 1), "", 1, 1): Next
   JaiLesMemes = s2 = ""
End Function

 

[mapomme]

Re à tous,

Un autre fonction plus générale. Elle accepte les expressions texte ou nombre.
Elle examine si les deux expressions contiennent les mêmes chiffres sans tenir compte des autres caractères (lettres, virgule, point, signe, espace).

Function JaiLesMemes(ByVal n1, ByVal n2) As Boolean
Dim s1$, s2$, i, c$
   For i = 1 To Len(n1): c = Mid(n1, i, 1): s1 = IIf(c >= "0" And c <= "9", s1 & c, s1): Next
   For i = 1 To Len(n2): c = Mid(n2, i, 1): s2 = IIf(c >= "0" And c <= "9", s2 & c, s2): Next
   If s1 = "" Or s2 = "" Then Exit Function
   For i = 1 To Len(s1): s2 = Replace(s2, Mid(s1, i, 1), "", 1, 1): Next
   JaiLesMemes = (s2 = "")
End Function

 

[Victor21]

Bonjour Serge, bonjour à tous.

En PJ visualisation des 7 vampires de 4 chiffres par formules.

 

[garnote]

Bonjour à Jacky67, TooFatBoy, mapomme et Victor 21,

Ouf! grosse matinée à Québec.
Merci pour ces si belles suggestions. De belles heures d'étude en vue.
J'ai utilisé la première version de la Function Vampire(Texte_1,Texte_2)
de TooFatBoy pour chercher les 7 nombres vampires à 4 chiffres.

Désolé pour la défaite de Gasquet face au monstre Nadal!

Bonne journée!
Serge

 

[Katido]

Bonjour,

Voici un fichier qui calcule (chez moi en une minute) les vampires jusqu'à 4 000 000 (feuille 1)
et qui teste si un nombre entré est un vampire (feuille 2).
J'ai supposé que les deux diviseurs peuvent avoir un nombre de chiffres différents.

 

[garnote]

Bonjour,

Voici un fichier qui calcule (chez moi en une minute) les vampires jusqu'à 4 000 000 (feuille 1)
et qui teste si un nombre entré est un vampire (feuille 2).
J'ai supposé que les deux diviseurs peuvent avoir un nombre de chiffres différents.

Les vampires n'ont qu'à bien se tenir!