TRI BASE DE DONNÉES EXCEL , Source N°7523

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é: 14 674 / 1 627

Auteur : laestrella

Ecrire un message privé

Note :

4,00 / 10

1
2
3
4
5
6
7
8
9
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

Toutes les sources de laestrella

Sources de la même categorie

Toutes les sources de la catégorie VBA

Commentaires

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