Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 06 01:33:53

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

RE : RECUPERER LE RESULTAS AFFICHER PAR LINVITE DE COMMANDE par jack

RECUPERER LE RESULTAS AFFICHER PAR LINVITE DE COMMANDE par liehuos001

RE : LORSQUE JE VEUX FAIRE LES ENREGISTREMENT DANS MA TABLE EN VB.NET UN MESSAGE S'AFFICHE EN ME DISANT QUE LE CHAMPS EST PETIT. QUE FAIE? par PCPT

RE : BUFFERING par pingouin84k

RE : SIMULER CTRL+A PUIS CTRL+C NE MARCHE PAS TOUT LE TEMPS .. POURQUOI ? par Renfield

+ de logiciels à télécharger

1 464 950 membres
5 nouveaux aujourd'hui
15 046 membres club

Trouver une ressource

Trouvez une ressource parmi 40 095 codes, 1 303 044 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

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 !

TRI BASE DE DONNÉES EXCEL

Information sur la source

Catégorie :VBA Niveau : Débutant Date de création : 18/06/2003 Date de mise à jour : 23/06/2003 10:57:13 Vu / téléchargé: 16 704 / 1 685

Auteur : laestrella

Ecrire un message privé

Note :

4,00 / 10

Commentaire sur cette source (5)

Ajouter un commentaire et/ou une note

Description

Exemple de tri de base de données sous excel. Pas si simple que ça!!!

Source

Private Sub Lancement_Click()
'lancement du tri
'var
Dim ligneinsert As Integer
Dim colonneinsert As Integer
Dim ligne As Integer
Dim colonne As Integer
Dim lb As Integer
Dim cb As Integer
Dim l As Integer
Dim C As Integer
Dim lm As Integer
Dim cm As Integer
Dim li As Integer
Dim co As Integer
Dim lice As Integer
Dim coce As Integer
'debut
lb = 4
cb = 1
ligne = 4
colonne = 1
ligneinsert = 7
colonneinsert = 1
l = 4
C = 1
lm = 4
cm = 1
li = 4
co = 1
lice = 4
coce = 1
'tant que l'on est pas arrivé au bout de la base de données
While Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value <> ""
'gestion des numéros innexistant
lice = 4
While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos crées").Cells(lice, coce).Value <> ""
If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Text = Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos crées").Cells(lice, coce).Text Then
ligneinsert = ligneinsert + 1
End If
lice = lice + 1
Wend
cm = 1
While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value <> ""
lm = lm + 1
Wend
C = 1
While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos correctes").Cells(l, C).Value <> ""
l = l + 1
Wend
If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 1).Value = "" Then
While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des N° inexistant").Cells(ligne, colonne).Value <> ""
ligne = ligne + 1
Wend
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des N° inexistant").Cells(ligne, colonne).Value = Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value
Else
'se positionner sur l'enregistrement voulu
While Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Value <> ""
If Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Value Like "*" & Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value Then
' aller à 1
GoTo 1
Else
lb = lb + 1
End If
Wend
'vérification du cost center
1 If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 2).Value Like Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 3).Value & "*" Then
'vérification du lieu
If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 3).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 4).Value Then
'vérification du batiment
If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 4).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 5).Value Then
'vérification de la sous section
If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 5).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 6).Value Then
'tout est bon
For C = 1 To 14
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos correctes").Cells(l, C).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
cb = cb + 1
Next
cb = 1
Else
'le cost center n'est pas bon
For cm = 1 To 14
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
cb = cb + 1
Next
cb = 1
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de sous centre"
End If
Else
'le lieu n'est pas bon
For cm = 1 To 14
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
cb = cb + 1
Next
cb = 1
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de batiment"
End If
Else
'le batiment n'est pas bon
For cm = 1 To 14
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
cb = cb + 1
Next
cb = 1
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de lieu"
End If
Else
'le sous centre n'est pas bon
For cm = 1 To 14
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
cb = cb + 1
Next
cb = 1
Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de cost center"
End If
End If
lb = 4
ligneinsert = ligneinsert + 1
Wend
End Sub

Private Sub Lancement_Click()
'lancement du tri
'var
Dim ligneinsert As Integer
Dim colonneinsert As Integer
Dim ligne As Integer
Dim colonne As Integer
Dim lb As Integer
Dim cb As Integer
Dim l As Integer
Dim C As Integer
Dim lm As Integer
Dim cm As Integer
Dim li As Integer
Dim co As Integer
Dim lice As Integer
Dim coce As Integer
'debut
lb = 4
cb = 1
ligne = 4
colonne = 1
ligneinsert = 7
colonneinsert = 1
l = 4
C = 1
lm = 4
cm = 1
li = 4
co = 1
lice = 4
coce = 1
'tant que l'on est pas arrivé au bout de la base de données
While Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value <> ""
    'gestion des numéros innexistant
   lice = 4
   While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos crées").Cells(lice, coce).Value <> ""
        If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Text = Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos crées").Cells(lice, coce).Text Then
            ligneinsert = ligneinsert + 1
        End If
        lice = lice + 1
    Wend
    cm = 1
    While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value <> ""
        lm = lm + 1
    Wend
    C = 1
    While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos correctes").Cells(l, C).Value <> ""
        l = l + 1
    Wend
    If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 1).Value = "" Then
        While Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des N° inexistant").Cells(ligne, colonne).Value <> ""
            ligne = ligne + 1
        Wend
        Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des N° inexistant").Cells(ligne, colonne).Value = Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value
    Else
        'se positionner sur l'enregistrement voulu
        While Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Value <> ""
            If Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Value Like "*" & Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert).Value Then
            '   aller à 1
                GoTo 1
            Else
                lb = lb + 1
            End If
        Wend
            'vérification du cost center
1       If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 2).Value Like Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 3).Value & "*" Then
                'vérification du lieu
            If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 3).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 4).Value Then
                    'vérification du batiment
                If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 4).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 5).Value Then
                        'vérification de la sous section
                    If Workbooks("Gestion d'immo présentation.xls").Sheets("Relevé des immos").Cells(ligneinsert, colonneinsert + 5).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb + 6).Value Then
                        'tout est bon
                        For C = 1 To 14
                            Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des immos correctes").Cells(l, C).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
                            cb = cb + 1
                        Next
                            cb = 1
                    Else
                            'le cost center n'est pas bon
                        For cm = 1 To 14
                            Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
                            cb = cb + 1
                        Next
                        cb = 1
                        Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de sous centre"
                    End If
                Else
                        'le lieu n'est pas bon
                    For cm = 1 To 14
                        Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
                        cb = cb + 1
                    Next
                    cb = 1
                    Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de batiment"
                End If
            Else
                    'le batiment n'est pas bon
                For cm = 1 To 14
                    Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
                    cb = cb + 1
                Next
                cb = 1
                Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de lieu"
            End If
        Else
                'le sous centre n'est pas bon
            For cm = 1 To 14
                Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, cm).Value = Workbooks("test base de données.xls").Sheets("DZ A FIN AVRIL 2003").Cells(lb, cb).Text
                cb = cb + 1
            Next
            cb = 1
            Workbooks("Gestion d'immo présentation.xls").Sheets("Etat des mauvaises affectations").Cells(lm, 15).Value = "erreur de cost center"
        End If
    End If
    lb = 4
   ligneinsert = ligneinsert + 1
Wend
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 !

tri.txt 6 499 octets

Télécharger le zip

Sources du même auteur

VOTRE RETRAITE C'EST POUR QUAND???

HORLOGE À L'ANCIENNE SOUS EXCEL (AIGUILLES)

JEU DES LAMPES ALLUMMÉES(HETPTAGRAMME)

SONDAGE FARCEUR SUR LES 35 HEURES

JEUX DE L'OIE SOUS EXCEL

Toutes les sources de laestrella

Sources de la même categorie

EXPORT TABLEAU EXCEL EN BBCODE par nikovb

AFFICHEUR DE LISTE AVEC VALIDATION (EXCEL) par AC045364

REDIMENSIONNER IMAGE par Le Pivert

RENOMMER SÉRIE D'IMAGE DIRECTEMENT AVEC VBA EXCEL (CLASSEMEN... par davidparison

STOCK_MAINTENANCE par awend

Toutes les sources de la catégorie VBA

Commentaires et avis

Commentaire de LordBob le 21/06/2003 22:49:23

tu devrai mettre tout ca dans un zip ca serai mieux...

Commentaire de laestrella le 23/06/2003 11:30:11

j'avais zappé pour le fichier ZIP maintenant c'est fait!!!

Commentaire de Willow05 le 23/06/2003 13:26:12

Zut ! j'ai pas eu le temps de mettre un commentaire pour le zip... 4 sources ??? et ben ^^ je vais aller voir ça
Sinon pas mal :p Aller, une ch'tite note ^^

Commentaire de LordBob le 23/06/2003 22:30:25

merci pour le zip...

Commentaire de jahrive le 09/02/2005 17:54:27

Pour trier la base Excel il existe une autre solution

Créer une plage nommée sur la base (feuille, range) en question

Ensuite le code est

Dim db as DAO.database
Dim Rs as DAO.recordset

'Définition du nom et du chemin du classeur (de la base)
"nom plage nommée = mabase"
'Si classeur actif'

var = Activeworkbook.path & "\" & Activeworkbook.name

set db = opendatabase(var,False,False,"excel 8.0")

"à partir de la connaisance SQL"
"Si pas connaissances SQL utiliser Access (requête affichage mode SQL)

req1 = "SELECT <nomchamps>.maplage ......" _
& " FROM maplage" _
& " WHERE <nomchamps>.maplage >0" _
& " ORDER BY .......

set Rs = db.openrecordset(req1)

"Pour vider le recordset dans le classeur Excel"
Workbboks("classeur").sheets("Feuille").Range("range").CopyFromRecordset RS