Modifier tableau 3 colonnes en 1 seule

tititou

XLDnaute Nouveau
Bonjour,

Tout d'abord, je m'excuse car mon intitulé n'est pas très clair ! Je n'ai pas trouvé mieux :cool:

Je vous explique mon problème : j'ai un tableau avec 3 colonnes.
J'aimerai créer un second tableau, dans un nouvel onglet, en ne conservant que les "oui" et ne prenant pas en compte les "non".

Dans la mesure du possible, j'aimerai ne pas utiliser de VBA.

Merci de votre aide !!!!
 

Pièces jointes

  • Excel colonne.xlsx
    10.2 KB · Affichages: 24

gosselien

XLDnaute Barbatruc
Re : Modifier tableau 3 colonnes en 1 seule

Bonjour,

dans ton exemple, on ne voit pas bien que tu conserves les OUI puisque ton tableau de droite a des données et puis des chiffres , pas de "oui"
je n'ai peut être pas compris , ça m'arrive (trop) souvent :)
 

gosselien

XLDnaute Barbatruc
Re : Modifier tableau 3 colonnes en 1 seule

re,

il y a surement mieux mais essaye ceci:

Option Explicit
Sub Group()
Dim Last As Integer
Dim Data, i, Cel, MColor
Last = [B65000].End(xlUp).Row
Set Data = [B1].End(xlDown)
MColor = Data.Interior.ColorIndex
i = 1
For Each Cel In Range("B3:B" & Last)
If UCase(Cel) = UCase("OUI") Then
Cells(i + 1, 10) = Cel.Offset(0, -1)
Cells(i + 1, 9) = Data
Range(Cells(i + 1, 9), Cells(i + 1, 10)).Interior.ColorIndex = MColor
i = i + 1
End If
Next
Set Data = [C1].End(xlDown)
MColor = Data.Interior.ColorIndex
For Each Cel In Range("C3:C" & Last)
If UCase(Cel) = UCase("OUI") Then
Cells(i + 1, 10) = Cel.Offset(0, -2)
Cells(i + 1, 9) = Data
Range(Cells(i + 1, 9), Cells(i + 1, 10)).Interior.ColorIndex = MColor
i = i + 1
End If
Next
End Sub
 

klin89

XLDnaute Accro
Re : Modifier tableau 3 colonnes en 1 seule

Bonsoir gosselien, tititou, le forum, :)

A tester :
VB:
Option Explicit
Option Compare Text

Sub test()
Dim a, b(), i As Long, j As Long, n As Long
    Application.ScreenUpdating = False
    a = Sheets(1).Range("a3").CurrentRegion.Value
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1) + 1, 1 To 2)
    b(1, 1) = "Lot": b(1, 2) = "Donnée"
    n = 1
    For i = 2 To UBound(a, 2)
        For j = 2 To UBound(a, 1)
            If a(j, i) = "oui" Then
                n = n + 1
                b(n, 1) = a(1, i)
                b(n, 2) = a(j, 1)
            End If
        Next
    Next
    'Restitution en Feuil2
    With Sheets(2)
        .Cells.Clear
        If n > 1 Then
            With .Cells(1)
                .Resize(n, 2).Value = b
                With .CurrentRegion
                    With .Rows(1)
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = 44
                    End With
                    .Font.Name = "calibri"
                    .Font.Size = 10
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlThin
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlCenter
                    '.Columns.AutoFit
                End With
            End With
        Else
            MsgBox "Aucune donnée"
        End If
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Modifier tableau 3 colonnes en 1 seule

Bonsoir,

Code:
Sub Essai()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("A5", [A65000].End(xlUp))
     If c.Offset(, 1) = "oui" Then d(c.Address & " Lot1") = c.Value
  Next c
  For Each c In Range("A5", [A65000].End(xlUp))
     If c.Offset(, 2) = "oui" Then d(c.Address & " Lot2") = c.Value
  Next c
  ligne = 5
  For Each c In d.keys
    a = Split(c, " "): a(0) = d(c)
    If IsNumeric(a(0)) Then Cells(ligne, "h") = CDbl(a(0)) Else Cells(ligne, "h") = a(0)
    Cells(ligne, "h").Offset(, 1) = a(1)
    ligne = ligne + 1
  Next
End Sub

JB
 

Pièces jointes

  • Excel colonne-1.xls
    43 KB · Affichages: 21
Dernière édition:

Discussions similaires