|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 GENERATEUR DE TABLEAUX DE NOMBRES POUR VB/VBA
 Information sur la source
 Description
Démo faite sur Excel. Fichier xls, dll (C et ASM), et txt contenant code de la dll dans zip. La dll ne génère que des tableaux de Long dans cette démo, chacun étendra selon ses besoins, si problème demander. Si gros tableau généré en début de procédure et plus utile par la suite, ne pas oublier de lui faire un 'erase'. Appel SetCurrentDirectory dans Workbook_Open() permet de mettre la dll dans même dossier que le xls.
 Source
- ' ------------------------ WORKBOOK OPEN
- Declare Sub SetCurrentDirectoryA Lib "Kernel32.dll" (ByVal pdir As String)
- ' ------------------------
-
- Declare Function bnTablEstNull Lib "bnArray.dll" (ptbl() As Any) As Long
-
- Declare Function bnTablInt32Alea Lib "bnArray.dll" (ByVal nelems As Long) As Long()
- Declare Function bnTablInt32AleaPstf Lib "bnArray.dll" (ByVal nelems As Long) As Long()
- ' PLAGE 24 BITS, 0 => 16777215
- Declare Function bnTablInt32TriAZ Lib "bnArray.dll" (ptbl() As Long) As Long
- ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
- Declare Function bnTablInt32TriZA Lib "bnArray.dll" (ptbl() As Long) As Long
- ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
- Declare Function bnTablInt32INVRS Lib "bnArray.dll" (ptbl() As Long) As Long
- ' RETOURNE LE NBR ELEMS INVERSES OU ZERO SI PAS BON
- Declare Function bnTablInt32AleaUnic Lib "bnArray.dll" (ByVal mini As Long, ByVal maxi As Long) As Long()
- ' PLAGE 16 BITS, mini >= 0, maxi <= 65535, maxi >= mini
- ' Sortira tableau valeurs uniques de nelems = (maxi - mini + 1)
- Declare Function bnTablInt32AleaBorne Lib "bnArray.dll" (ByVal nelems As Long, ByVal mini As Long, ByVal maxi As Long) As Long()
- ' PLAGE 16 BITS, mini >= 0, maxi <= 65535, maxi >= mini
- ' AUCUN TEST D'UNICITE DES VALEURS QUI SORTENT
-
- ' ------------------------
- Private Sub Workbook_Open()
- SetCurrentDirectoryA ThisWorkbook.Path
- End Sub
- ' ------------------------
-
- Sub TestInt32()
- Dim tabl() As Long, i As Long, maxi As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32Alea(1000)
- If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE
- Cells(1, 1) = "DEFAUT MEMOIRE"
- Exit Sub
- End If
- maxi = UBound(tabl)
- For i = 0 To maxi
- Cells(i + 1, 1) = tabl(i)
- Next i
- End Sub
-
- Sub TestIn32Positifs()
- Dim tabl() As Long, i As Long, maxi As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32AleaPstf(500)
- If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE
- Cells(1, 1) = "DEFAUT MEMOIRE"
- Exit Sub
- End If
- maxi = UBound(tabl)
- For i = 0 To maxi
- Cells(i + 1, 1) = tabl(i)
- Next i
- End Sub
-
- Sub TrierTablLong()
- Dim tabl() As Long, tries As Long, i As Long, ubnd As Long, r As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32AleaPstf(2000)
- ' tries = bnTablInt32TriAZ(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
- tries = bnTablInt32TriZA(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
- Cells(1, 2) = tries
- If tries = 0 Then Exit Sub
- i = LBound(tabl)
- ubnd = UBound(tabl)
- If tries <> (ubnd - i + 1) Then Exit Sub
- r = 0
- While i <= ubnd
- r = r + 1
- Cells(r, 1) = tabl(i)
- i = i + 1
- Wend
- End Sub
-
- Sub ReverseTablLong()
- Dim tabl() As Long, tries As Long, i As Long, ubnd As Long, r As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32AleaPstf(25)
- tries = bnTablInt32TriAZ(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
- Cells(1, 2) = tries
- If tries = 0 Then Exit Sub
- i = LBound(tabl)
- ubnd = UBound(tabl)
- If tries <> (ubnd - i + 1) Then Exit Sub
- r = 0
- While i <= ubnd
- r = r + 1
- Cells(r, 1) = tabl(i)
- i = i + 1
- Wend
- tries = bnTablInt32INVRS(tabl) ' RETOURNE LE NBR ELEMS INVERSES OU ZERO SI PAS BON
- Cells(1, 4) = tries
- If tries = 0 Then Exit Sub
- i = LBound(tabl)
- ubnd = UBound(tabl)
- If tries <> (ubnd - i + 1) Then Exit Sub
- r = 0
- While i <= ubnd
- r = r + 1
- Cells(r, 3) = tabl(i)
- i = i + 1
- Wend
- End Sub
-
- Sub TestAleaUnic()
- Dim tabl() As Long, i As Long, ubnd As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32AleaUnic(0, 1000) ' TABLEAU DE (max - min + 1) NBR
- If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE OU ERREUR PARAMS
- Cells(1, 2) = "ERREUR"
- Exit Sub
- End If
- ubnd = UBound(tabl)
- Cells(1, 2) = ubnd + 1
- For i = 0 To ubnd
- Cells(i + 1, 1) = tabl(i)
- Next i
- End Sub
-
- Sub TestAleaBorne()
- Dim tabl() As Long, i As Long, ubnd As Long
- Columns("A:D").ClearContents
- tabl = bnTablInt32AleaBorne(1000, 0, 1000) ' TABLEAU DE x NBR COMPRIS ENTRE min ET max INCLUS
- If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE OU ERREUR PARAMS
- Cells(1, 2) = "ERREUR"
- Exit Sub
- End If
- ubnd = UBound(tabl)
- Cells(1, 2) = ubnd + 1
- For i = 0 To ubnd
- Cells(i + 1, 1) = tabl(i)
- Next i
- End Sub
' ------------------------ WORKBOOK OPEN
Declare Sub SetCurrentDirectoryA Lib "Kernel32.dll" (ByVal pdir As String)
' ------------------------
Declare Function bnTablEstNull Lib "bnArray.dll" (ptbl() As Any) As Long
Declare Function bnTablInt32Alea Lib "bnArray.dll" (ByVal nelems As Long) As Long()
Declare Function bnTablInt32AleaPstf Lib "bnArray.dll" (ByVal nelems As Long) As Long()
' PLAGE 24 BITS, 0 => 16777215
Declare Function bnTablInt32TriAZ Lib "bnArray.dll" (ptbl() As Long) As Long
' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
Declare Function bnTablInt32TriZA Lib "bnArray.dll" (ptbl() As Long) As Long
' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
Declare Function bnTablInt32INVRS Lib "bnArray.dll" (ptbl() As Long) As Long
' RETOURNE LE NBR ELEMS INVERSES OU ZERO SI PAS BON
Declare Function bnTablInt32AleaUnic Lib "bnArray.dll" (ByVal mini As Long, ByVal maxi As Long) As Long()
' PLAGE 16 BITS, mini >= 0, maxi <= 65535, maxi >= mini
' Sortira tableau valeurs uniques de nelems = (maxi - mini + 1)
Declare Function bnTablInt32AleaBorne Lib "bnArray.dll" (ByVal nelems As Long, ByVal mini As Long, ByVal maxi As Long) As Long()
' PLAGE 16 BITS, mini >= 0, maxi <= 65535, maxi >= mini
' AUCUN TEST D'UNICITE DES VALEURS QUI SORTENT
' ------------------------
Private Sub Workbook_Open()
SetCurrentDirectoryA ThisWorkbook.Path
End Sub
' ------------------------
Sub TestInt32()
Dim tabl() As Long, i As Long, maxi As Long
Columns("A:D").ClearContents
tabl = bnTablInt32Alea(1000)
If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE
Cells(1, 1) = "DEFAUT MEMOIRE"
Exit Sub
End If
maxi = UBound(tabl)
For i = 0 To maxi
Cells(i + 1, 1) = tabl(i)
Next i
End Sub
Sub TestIn32Positifs()
Dim tabl() As Long, i As Long, maxi As Long
Columns("A:D").ClearContents
tabl = bnTablInt32AleaPstf(500)
If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE
Cells(1, 1) = "DEFAUT MEMOIRE"
Exit Sub
End If
maxi = UBound(tabl)
For i = 0 To maxi
Cells(i + 1, 1) = tabl(i)
Next i
End Sub
Sub TrierTablLong()
Dim tabl() As Long, tries As Long, i As Long, ubnd As Long, r As Long
Columns("A:D").ClearContents
tabl = bnTablInt32AleaPstf(2000)
' tries = bnTablInt32TriAZ(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
tries = bnTablInt32TriZA(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
Cells(1, 2) = tries
If tries = 0 Then Exit Sub
i = LBound(tabl)
ubnd = UBound(tabl)
If tries <> (ubnd - i + 1) Then Exit Sub
r = 0
While i <= ubnd
r = r + 1
Cells(r, 1) = tabl(i)
i = i + 1
Wend
End Sub
Sub ReverseTablLong()
Dim tabl() As Long, tries As Long, i As Long, ubnd As Long, r As Long
Columns("A:D").ClearContents
tabl = bnTablInt32AleaPstf(25)
tries = bnTablInt32TriAZ(tabl) ' RETOURNE LE NBR ELEMS TRIES OU ZERO SI PAS BON
Cells(1, 2) = tries
If tries = 0 Then Exit Sub
i = LBound(tabl)
ubnd = UBound(tabl)
If tries <> (ubnd - i + 1) Then Exit Sub
r = 0
While i <= ubnd
r = r + 1
Cells(r, 1) = tabl(i)
i = i + 1
Wend
tries = bnTablInt32INVRS(tabl) ' RETOURNE LE NBR ELEMS INVERSES OU ZERO SI PAS BON
Cells(1, 4) = tries
If tries = 0 Then Exit Sub
i = LBound(tabl)
ubnd = UBound(tabl)
If tries <> (ubnd - i + 1) Then Exit Sub
r = 0
While i <= ubnd
r = r + 1
Cells(r, 3) = tabl(i)
i = i + 1
Wend
End Sub
Sub TestAleaUnic()
Dim tabl() As Long, i As Long, ubnd As Long
Columns("A:D").ClearContents
tabl = bnTablInt32AleaUnic(0, 1000) ' TABLEAU DE (max - min + 1) NBR
If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE OU ERREUR PARAMS
Cells(1, 2) = "ERREUR"
Exit Sub
End If
ubnd = UBound(tabl)
Cells(1, 2) = ubnd + 1
For i = 0 To ubnd
Cells(i + 1, 1) = tabl(i)
Next i
End Sub
Sub TestAleaBorne()
Dim tabl() As Long, i As Long, ubnd As Long
Columns("A:D").ClearContents
tabl = bnTablInt32AleaBorne(1000, 0, 1000) ' TABLEAU DE x NBR COMPRIS ENTRE min ET max INCLUS
If bnTablEstNull(tabl) Then ' DLL RETOURNE 0 SI MANQUE DE MEMOIRE OU ERREUR PARAMS
Cells(1, 2) = "ERREUR"
Exit Sub
End If
ubnd = UBound(tabl)
Cells(1, 2) = ubnd + 1
For i = 0 To ubnd
Cells(i + 1, 1) = tabl(i)
Next i
End Sub
 Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
 Télécharger le zip
 Historique
- 26 octobre 2005 16:40:04 :
- Site
- 08 octobre 2006 14:07:53 :
- site
 Sources du même auteur
 Sources de la même categorie
Sources en rapport avec celle ci
 Commentaires et avis
 Discussions en rapport avec ce code source dans le forum
Programme de TRI [ par jia2812 ]
Slt les progs'!Voilà, je voudrais faire 1 code qui permet de faire des tris des nombres. J'en ai fait, mais j'me demande s'il est bien optimisé?... Al
Specialiste du tri de tableaux [ par tmcuh ]
voilà j'ai un fichier à trié sur 2 colonnes à la fois la premières étant par nombre croissant jusque là cà va (je fais cà par Shell-Metzner : nickel c
tri lisbox [ par soleildz ]
salutj'ai deux colonnes ,la premireres contient des nombres etla deuxieme des mots.je veux trier suivant la premiere colonne(les nombres)dans l'ordre
tri [ par LUCA62 ]
j'ai une suite (6 nombres) de nombre à trier, voilà comment j'ai fait : public i, jdim k as integer &
Tri de caractéres mélangés avec des chiffres [ par sacotte ]
Je cherche à trouver quelle option il faut mettre dans une requete SQL qui est en relation avec une base mdb(access) pour que le tri des nombres se fa
Cherche une fontion aléatoire :) [ par calj ]
Voila apriori cette question est pas tres compliquer.Mais voila g un probleme avec la fonction rndMetton un code dans le style :Private Sub Command1_C
prog en fortran [ par stephnico ]
Bonjour à tous,cela fait près d'une semaine que je travail sur un prog fortran qui permet de renvoyer tous les nombres premiers compris entre 1 et un
erreur d'exécution 13 [ par Mister_one7479 ]
Bonjour , je vais droit au but j'ai un problème j'ai fait une application en vb et quand je la lance tt nikel je rentre mes caractéristique entre autr
tri sur colonne excel !! svp !! [ par bili75 ]
salut,je désire trier une colonne pour ensuite dupliqué le fichier excel en autant de fichier qu'il y a de valeurs differentes sur la colone.j'ai le c
combinaisons de nombres [ par hhhp2004 ]
hhhp2004je suis a la recherche d'un code qui me permettrai de faire de combinaisons de nombres. Exemple , on a 10 numeos : 1, 2, 3, 4 ...10. La je vai
|
 Téléchargements
Logiciels à télécharger sur le même thème :
|