begin process at 2010 03 21 07:55:29
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

API

 > GENERATEUR DE TABLEAUX DE NOMBRES POUR VB/VBA

GENERATEUR DE TABLEAUX DE NOMBRES POUR VB/VBA


 Information sur la source

Note :
10 / 10 - par 2 personnes
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :API Classé sous :generateur, tableaux, nombres, tri, aléatoire Niveau :Débutant Date de création :24/09/2005 Date de mise à jour :08/10/2006 14:07:53 Vu / téléchargé :8 990 / 398

Auteur : BruNews

Ecrire un message privé
Site perso
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note


 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

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
  • bnArray.dllTélécharger ce fichier [Réservé aux membres club]3 584 octets
  • CodAsmC.txtTélécharger ce fichier [Réservé aux membres club]Voir ce fichier8 711 octets
  • Tests.xlsTélécharger ce fichier [Réservé aux membres club]45 568 octets

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

Source avec Zip COMPRESSION PAR DLL
Source avec Zip VIRGULES <=> POINTS, REMPLACE DANS FICHIER PAR DLL
Source avec Zip DLL POUR VB/VBA (9)
Source avec Zip CTRL+ALT+SUPPR INTERCEPTION SUR XP
Source avec Zip DLL POUR VB/VBA (8)

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) UTILISATION DE L' API GOOGLE YOUTUBE RECHERCHER ET LIRE DES ... par tresorsdevie
Source avec Zip Source avec une capture Source .NET (Dotnet) FAIRE LA DIFFÉRENCE ENTRE UNE ADRESSE EMAIL QUI EXISTE D'UNE... par lesinfosdugeek
ENVOYER UN MESSAGE SUR SON COMPTE TWITTER par lesinfosdugeek
Source avec Zip Source avec une capture TROUVER LES CLÉS DE REGISTRE QUI CHANGENT par Flocreate
Source avec Zip IP_PUBLIQUE_INTERNETGETCONNECTEDSTATE par marco62118

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture TRI PAR INSERTION par jmc70
Source avec Zip Source avec une capture Source .NET (Dotnet) EDITION DE CARACTÈRES MATRICIELS (POUR BITMAP, CF CODE 128) par Blodox
Source avec Zip Source avec une capture CRÉE FACILEMENT SIGNATURE POUR OUTLOOK EXPRESS EN FICHIER HT... par stef68600
Source avec Zip Source avec une capture GÉNERATEUR DE MOTS DE PASSE WEP par jupevi
Source avec Zip Source avec une capture TRI DES ITEMS DE LISTVIEW (DATE, NUMÉRIQUE OU PERSO) par Renfield

Commentaires et avis

Commentaire de BruNews le 24/09/2005 19:46:57 administrateur CS

Oublié de préciser:
bnTablEstNull() permet de tester si tableau non nul en retour de dll, je n'ai pas trouvé le moyen de tester cela en VB, alors je l'ai écrit.

 Ajouter un commentaire


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)&nbsp;de nombre &#224; trier, voil&#224; comment j'ai fait :&nbsp;public i, jdim k as integer&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;& 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 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 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


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Mars 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
293031    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,983 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales