XL 2016 Curiosités numériques et VBA

garnote à dit:

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

Cliquez pour agrandir...

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

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

Jacky67 à dit:

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

VB:

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

Code:

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

Cliquez pour agrandir...

garnote à dit:

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

Cliquez pour agrandir...

garnote à dit:

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.

Cliquez pour agrandir...

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

Katido à dit:

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.

Cliquez pour agrandir...