otobox Maison fondée en 2005 | Le code parle tout seul. Indiquer seulement l'endroit où commencent les données dans la section 'Initialisation des variables (ligne 23 et suivantes) et éventuellement le nom des en-tête de colonnes de sortie, ainsi que le nom de la feuille créée.
Code :
- Sub teamamenore()
- Dim colDataIn As Integer 'N° colonne contenant les données d'entrée
- Dim ligDataIn As Integer 'N° ligne contenant les données d'entrée
- Dim colDataOut As Integer 'N° colonne contenant les données de sortie
- Dim ligDataOut As Integer 'N° ligne contenant les données de sortie
- Dim intLigEntete As Integer 'N° de ligne où sont stocké les nom des entete d'entrée
- Dim intColEntete As Integer 'N° de colonne où sont stocké les nom des entete d'entrée
- Dim strRepCol As String 'Nom de la colonne d'entrée courante
- Dim strRepLig As String 'Nom de la ligne d'entrée courante
- Dim strExpres As String 'Expression Ligne*Colonne
- Dim strData As String 'Donnée courante traitée
- Dim strEntete1 As String 'Nom de l'entete de la colonne 1 de la feuille de sortie
- Dim strEntete2 As String 'Nom de l'entete de la colonne 2 de la feuille de sortie
- Dim FeuilIn As Worksheet 'Feuille (objet) où sont stockées les données d'entrée
- Dim FeuilOut As Worksheet 'Feuille (objet) où sont stockées les données de sortie
- Dim strNomFeuille As String 'Nom de la feuille contenant les données de sortie
- 'Initialisation des variables
- Set FeuilIn = ActiveSheet
- intLigEntete = 1 '<- Indiquer ici le n° de ligne où sont indiqué les en-tête de colonnes
- intColEntete = 1 '<- Indiquer ici le n° de colonne où sont indiqué les en-tête de ligne (A=1, B=2 etc.)
- strNomFeuille = "Données en colonne" 'Nom de la feuille de donnée de sortie
- strEntete1 = "Col1"
- strEntete2 = "Col2"
- colDataIn = intColEntete + 1 'Les donnée d'entrées commencent à la deuxième colonne (après entete)
- ligDataIn = intLigEntete + 1 'Les donnée d'entrées commencent à la deuxième ligne (sous entete)
- ligDataOut = 2
- 'Création de la feuille de donnée de sortie
- 'Suppression de cette feuille si elle existe
- EffacerFeuille (strNomFeuille)
- 'Création de la feuille
- Sheets.Add.Name = strNomFeuille
- Set FeuilOut = Sheets(strNomFeuille)
- 'Création des entêtes (col1 et col2) sur cette nouvelle feuille
- FeuilOut.Cells(1, 1) = strEntete1
- FeuilOut.Cells(1, 2) = strEntete2
- 'Parcours du tableau des données d'entrées
- 'Lecture du tableau par ligne
- Do
- strData = FeuilIn.Cells(ligDataIn, colDataIn)
- If strData = "" Then Exit Do '(sort de la boucle si la cellule est vide = bas du tableau)
- 'Lecture de la ligne du tableau
- Do
- strData = FeuilIn.Cells(ligDataIn, colDataIn)
- If strData = "" Then Exit Do '(sort de la boucle si la cellule est vide = fin de ligne)
- 'Composition de l'expression Ligne*Colonne :
- 'Lecture du repère de la ligne
- strRepLig = FeuilIn.Cells(ligDataIn, intColEntete)
- 'Lecture du repère de la colonne
- strRepCol = FeuilIn.Cells(intLigEntete, colDataIn)
- 'Expression :
- strExpres = strRepLig & "*" & strRepCol
- 'Ecriture sur la feuille de sortie de l'expression Ligne*Colonne
- FeuilOut.Cells(ligDataOut, 1) = strExpres
- 'Ecriture sur la feuille de sortie de la donnée
- FeuilOut.Cells(ligDataOut, 2) = strData
- 'On passe à la colonne suivante dans le tableau d'entrée
- colDataIn = colDataIn + 1
- 'On passe à la ligne suivante dans le tableau de sorti
- ligDataOut = ligDataOut + 1
- Loop 'on passe à la colonne suivante
- 'On passe à la ligne suivante du tableau d'entrée
- ligDataIn = ligDataIn + 1
- 'On revient à la première colonne du tableau d'entrée
- colDataIn = intColEntete + 1
- Loop 'et on recommence à lire la ligne suivante...
- End Sub
- Private Sub EffacerFeuille(nomFeuille As String)
- On Error Resume Next
- 'Eviter les messages d'alerte
- Application.DisplayAlerts = False
- 'Effacer la feuille existante :
- Sheets(nomFeuille).Delete
- 'Remet les messages d'alerte
- Application.DisplayAlerts = True
- End Sub
|
(TIP: Double clic dans la fenêtre du code ci-dessus pour enlever les numéros de ligne avant de copier-coller vers l'éditeur vba)
JM ---------------
OtObOxBlOg - - - Etre seul à avoir tort c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
|
