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

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

Ce site au démarrage

begin process at 2012 02 16 12:57:12

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

TRI BASE DE DONNÉES EXCEL

Information sur la source

Note :

4,00 / 10

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é :19 412 / 1 754

Auteur : laestrella

Ecrire un message privé

Commentaire sur cette source (6)

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

Les Membres Club peuvent 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

OUTLOOK ATTACHEMENT SAVER par MoiLafouine

GESTION PERSONNEL par oudlarbi

CALENDRIER EN VBA POUR EXCEL 2010 par nounou94

MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai

COLLECTION ID par Le Pivert

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

Commentaire de kastin le 20/03/2011 11:22:11

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.

Ajouter un commentaire

Nos sponsors

Derniers Blogs

[HTML5] SLIDES ET DéMOS : AUTOUR DU W3C , NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio

GESTION D'EXCEPTION AVEC LES TASKS par richardc

DéMARRONS AVEC LES TASKS par richardc

SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko

XNA IS DEAD! par richardc

Forum

RE : AFFICHER DES FICHIERS COMPLETS par freepicbasic

RE : LISTVIEW TAILLE par ucfoutu

RE : AFFICHER DES FICHIERS COMPLETS par freepicbasic

RE : VBS ET ANTIVIRUS par YOUSSA3216

RE : AFFICHER DES FICHIERS COMPLETS par ucfoutu

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Creation d-une application web Prediction Energy Tool-CDC DISPONIBLE-REPUBLICATION
Budget : 12 000€
Finalisation site d-encheres au centime
Budget : 2 800€
Recherche expert webmarketing
Budget : 3 000€

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