Bonjour,
J'ai besoin de votre aide pour le probleme suivant
j'ai tableau de type
2 b 1 e - -
1 a 4 f 2 y
4 d - - 5 z
3 c - - 3 w
je voudrais le mettre dans une autre feuille et de type
1 a e -
2 b - y
3 c - w
4 d f -
5 - - z
c'est à dire
les numeros seront rangés dans la colonne 1 par ordre croisssant
J'ai proposé ce code
Mais Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0), il marche pas
code
Dim Ligne As Integer
Dim l As Long
Dim c As Long
l = 2
c = 1
Dim i As Long
Dim j As Long
Dim lt As Long
Dim ct As Long
Dim lbel as long
Dim ltA As Long
Dim tablout1 As Variant
Dim tablout As Variant
Dim Lig As Integer
Set plage = range("a1:a" & range("a1").End(xlDown).Row)
nbrligne = plage.Cells.Count
colatraiter = 0
indice = 0
Ligne = 1
test = False
j = 1 UBound(tablout, 2) Step 2
i = 1 UBound(tablout, 1) step1
Do While (Worksheets("data").Cells(l, c).value <> "")
l = 2
Do While (Worksheets("data").Cells(l, c).value <> "")
'Do While Application.CountA(Sheets("data").Columns(c)) <> Application.CountA(Sheets("output").Columns(c))
colatraiter = c + 2
libel = Worksheets("data").Cells(l, c).value
value = Worksheets("data").Cells(l, colatraiter).value
If (value <> "") Then
If (value >= 2) Then
montab(indice, c) = libel
montab(indice, c) = ligne
ligne = ligne + 1
indice = indice + 1
Worksheets("output").Select
lt = Sheets("output").Cells(37500, j).End(xlUp).Row + 1
tablout = Sheets("output").range(Cells(1, 1), Cells(lt, ct)).value
ltA = UBound(tablout, 1)
lt = Sheets("output").range(ActiveCell, ActiveCell.End(xlUp)).Row + 1
ct = Sheets("output").range("a1").CurrentRegion.Columns.Count + 1
tablout1 = Sheets("output").range("a1", Cells(range("C65536").End(xlUp).Row)).value
For i = 1 To ltA
If Application.CountIf(range("A:A"), libel) > 0 Then
Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0)
tablout(Lig, j + 1) = cells(c,l)
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
Else
tablout(ltA, 1) = libel
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
End If
Next i
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
End If
End If
l = l + 1
Loop
c = c + 2
indice = 1
Ligne = 1
j = j + 1
l = 2
i = 1
Loop
End Sub
Merci pour votre aide
J'ai besoin de votre aide pour le probleme suivant
j'ai tableau de type
2 b 1 e - -
1 a 4 f 2 y
4 d - - 5 z
3 c - - 3 w
je voudrais le mettre dans une autre feuille et de type
1 a e -
2 b - y
3 c - w
4 d f -
5 - - z
c'est à dire
les numeros seront rangés dans la colonne 1 par ordre croisssant
J'ai proposé ce code
Mais Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0), il marche pas
code
Dim Ligne As Integer
Dim l As Long
Dim c As Long
l = 2
c = 1
Dim i As Long
Dim j As Long
Dim lt As Long
Dim ct As Long
Dim lbel as long
Dim ltA As Long
Dim tablout1 As Variant
Dim tablout As Variant
Dim Lig As Integer
Set plage = range("a1:a" & range("a1").End(xlDown).Row)
nbrligne = plage.Cells.Count
colatraiter = 0
indice = 0
Ligne = 1
test = False
j = 1 UBound(tablout, 2) Step 2
i = 1 UBound(tablout, 1) step1
Do While (Worksheets("data").Cells(l, c).value <> "")
l = 2
Do While (Worksheets("data").Cells(l, c).value <> "")
'Do While Application.CountA(Sheets("data").Columns(c)) <> Application.CountA(Sheets("output").Columns(c))
colatraiter = c + 2
libel = Worksheets("data").Cells(l, c).value
value = Worksheets("data").Cells(l, colatraiter).value
If (value <> "") Then
If (value >= 2) Then
montab(indice, c) = libel
montab(indice, c) = ligne
ligne = ligne + 1
indice = indice + 1
Worksheets("output").Select
lt = Sheets("output").Cells(37500, j).End(xlUp).Row + 1
tablout = Sheets("output").range(Cells(1, 1), Cells(lt, ct)).value
ltA = UBound(tablout, 1)
lt = Sheets("output").range(ActiveCell, ActiveCell.End(xlUp)).Row + 1
ct = Sheets("output").range("a1").CurrentRegion.Columns.Count + 1
tablout1 = Sheets("output").range("a1", Cells(range("C65536").End(xlUp).Row)).value
For i = 1 To ltA
If Application.CountIf(range("A:A"), libel) > 0 Then
Lig = Application.WorksheetFunction.Match(libel, range("A:A"), 0)
tablout(Lig, j + 1) = cells(c,l)
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
Else
tablout(ltA, 1) = libel
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
End If
Next i
ReDim Preserve tablout(1 To lt, 1 To ct)
range(Cells(1, 1), Cells(lt, ct)).value = tablout
End If
End If
l = l + 1
Loop
c = c + 2
indice = 1
Ligne = 1
j = j + 1
l = 2
i = 1
Loop
End Sub
Merci pour votre aide
Dernière édition: