1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources VBA
  5. Tri base de données excel

Tri base de données excel

Soyez le premier à donner votre avis sur cette source.

Vue 21 252 fois - Téléchargée 1 859 fois

Télécharger le projet
Commenter

Description

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

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
1
Date d'inscription
vendredi 7 mai 2010
Statut
Membre
Dernière intervention
20 mars 2011
le téléchargement des fichiers Zippé sa un peu de problème parce que d'autre utilisateur on toujours tendance de détruire ce pour quoi je voulais signale qu'on puisse nous envoyé des fichier zip avec un code de déverrouillage merci à codes-sources.
Signaler
Messages postés
6
Date d'inscription
vendredi 10 décembre 2004
Statut
Membre
Dernière intervention
19 novembre 2005
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
Signaler
Messages postés
2865
Date d'inscription
samedi 2 novembre 2002
Statut
Membre
Dernière intervention
11 mai 2009
 11
merci pour le zip...
Signaler
Messages postés
36
Date d'inscription
mercredi 11 juin 2003
Statut
Membre
Dernière intervention
27 juin 2003
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 ^^
Signaler
Messages postés
93
Date d'inscription
lundi 16 juin 2003
Statut
Membre
Dernière intervention
27 juin 2003
j'avais zappé pour le fichier ZIP maintenant c'est fait!!!
Afficher les 6 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_laestrella)