Accueil > > > GENERATEUR DE TABLEAUX DE NOMBRES POUR VB/VBA
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
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
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 &
Requette de tri des nombres de version [ par bizerte ]
Est-ce que vous avez une idée sur la requête qui permet de faire le tri des nombres de version (1 , 1.1 , 1.2, 1.3 ..1.10, 1.11 ,2, 2.1..) car avec Or
tri et cumul [ par detbour ]
Bonjour g recuperer les tirage de l'euromillion pour m'amuser je voudrais faire un tri. Jusque la rien de compliquer par contre en suite c pour compte
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
|
Derniers Blogs
PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS !PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS ! par Etienne Margraff
J'ai récemment eu un problème pour obtenir l'intelliTrace sur un site web dans IIS. Il n'y avait pas de message d'erreur, rien dans le journal d'évènement Windows, et après 3 appels à une voyante, 2 visites chez un marabou, j'ai failli me résign...
Cliquez pour lire la suite de l'article par Etienne Margraff OFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONSOFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONS par junarnoalg
De nombreuses entreprises font le choix de SharePoint Online, service fourni au travers de l'offre de Microsoft Office 365. S'il est vrai que ce choix apporte un grand nombre d'avantages; rapidité de mise en œuvre, disponibilité, large couvertu...
Cliquez pour lire la suite de l'article par junarnoalg PRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGEPRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGE par richardc
http://www.c2idotnet.com/articles/presentation-des-api-rest-de-windows-azure-lister-les-comptes-de-storage
Désolé pour "toto", mais c2i existait avant blogs.developpeur.org et c'est mon site "officiel" ;-) ...
Cliquez pour lire la suite de l'article par richardc [HTML5] SLIDES ET DéMOS : AUTOUR DU W3C , NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] SLIDES ET DéMOS : AUTOUR DU W3C , NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Très bonne après-midi passée lors cette conférence avec le W3C, organisée par L' Inria sur les nouveaux standards, ce Mardi 14 Février, on sent vraiment que çà bosse au W3C, et l'avenir est très très prometteur pour le HTML5, notamment ...
Cliquez pour lire la suite de l'article par Gio
Forum
FONCTION EXCEL VBAFONCTION EXCEL VBA par samanta26
Cliquez pour lire la suite par samanta26 RE : VITESSERE : VITESSE par ossama261988
Cliquez pour lire la suite par ossama261988
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|