Transposer les lignes et les colonnes d'un tableau de données
r
bonjour,
Ci-joint un classeur avec 2 feuilles. Je souhaiterais restructurer les données qui sont dans la feuille Compile au sein de la feuille Mapping. Cela consisterait, en gros, à transposer les lignes avec les colonnes....mais pas que.
La macro ci-dessous s'approche du résultat mais elle ne trait que le range C3:CT98 et je ne parviens pas à l'étendre aux autres lignes du tableau :
Auriez-vous une idée?
Sub CopyValuesToMapping()
Dim wsCompile As Worksheet
Dim wsMapping As Worksheet
Dim headerRow As Range
Dim lastRow As Long
Dim i As Long, j As Long
Dim matchColumn As Range
Dim searchHeader As String
Dim matchValue As Variant
Dim cellRow As Long
Dim cellCol As String
' Référencer les feuilles de travail
Set wsCompile = ThisWorkbook.Sheets("Compile")
Set wsMapping = ThisWorkbook.Sheets("Mapping")
Set headerRow = wsCompile.Rows("1")
' Parcourir les cellules de la ligne 3 de la feuille Mapping
For j = 3 To 98
cellRow = 3
cellCol = wsMapping.Cells(cellRow, j).Address(False, False)
' Obtenez le texte de la cellule A3 sur Mapping
searchHeader = wsMapping.Range("A" & cellRow).Value
' Rechercher l'en-tête correspondant dans Compile
On Error Resume Next
Set matchColumn = headerRow.Find(What:=searchHeader, LookIn:=xlValues, LookAt:=xlWhole)
On Error GoTo 0
If Not matchColumn Is Nothing Then
lastRow = wsCompile.Cells(wsCompile.Rows.Count, matchColumn.Column).End(xlUp).Row
' Limitez la recherche aux 901 premières lignes
If lastRow > 901 Then lastRow = 901
' Parcourir les cellules pour trouver la correspondance
For i = 1 To lastRow
If wsCompile.Cells(i, 3).Value = wsMapping.Cells(2, j).Value Then
matchValue = wsCompile.Cells(i, matchColumn.Column).Value
Exit For
End If
Next i
' Copier la valeur correspondante
wsMapping.Range(cellCol).Value = matchValue
Else
wsMapping.Range(cellCol).Value = "Aucune correspondance d'en-tête"
End If
Next j
End Sub
f
Bonjour
Sans chercher plus loin
For j = 98 To wsMapping.Cells(k, Columns.Count).End(xlToLeft).Column ' De la colonne C à CTwsMapping.Cells(k, Columns.Count).End(xlToLeft).Column est egale à 98....
Tu cherches ce qui est en colonne 1: "ext1",etc en ligne 1 "A1", ect....
A+ Françoisr
pour info et pour ceux qui seraient intéressés, voici un code qui fonctionne :
Sub RemplirMapping()
Dim wsCompile As Worksheet, wsMapping As Worksheet
Dim i As Long, j As Long
Dim dateRow As Long, thermoCol As Long, hourRow As Long
Dim thermoName As String, theDate As Date, theHour As String
Set wsCompile = ThisWorkbook.Sheets("Compile")
Set wsMapping = ThisWorkbook.Sheets("Mapping")
For i = 3 To 901 ' Pour chaque ligne dans Mapping
thermoName = wsMapping.Cells(i, 1).value
theDate = wsMapping.Cells(i, 2).value
thermoCol = 0
dateRow = 0
hourRow = 0
' Trouver la colonne du thermomètre
For j = 4 To 34 ' à adapter selon le nombre de thermomètres
If wsCompile.Cells(1, j).value = thermoName Then
thermoCol = j
Exit For
End If
Next j
' Trouver la ligne de la date
For j = 2 To 2689 ' à adapter selon le nombre de lignes dans Compile
If wsCompile.Cells(j, 2).value = theDate Then
dateRow = j
Exit For
End If
Next j
' Pour chaque heure
For j = 3 To 98 ' à adapter selon le nombre d'heures (C2:CT2)
theHour = wsMapping.Cells(2, j).value
hourRow = 0
' Trouver la ligne de l'heure
For k = dateRow To dateRow + 95 ' 96 repères horaires
If wsCompile.Cells(k, 3).value = theHour Then
hourRow = k
Exit For
End If
Next k
If thermoCol > 0 And hourRow > 0 Then
wsMapping.Cells(i, j).value = wsCompile.Cells(hourRow, thermoCol).value
End If
Next j
Next i
End Subje clôture le sujet :)