Discussion :

[straipe]

Bonjour,

Je cherche une façon de trouver dans un document excel différents mots comme:
Tablette, Produits
Lorsque je trouve un de ces mots, la cellule a la droite de Produits(ou tablette), est le nom du produit / et sous le produit est la quantité de ce produit

Je veux prendre ce # de produit et la quantité et le copier dans une autre feuille, dans les colonnes correspondantes

Plus d'un produit peuvent être sur la ligne produit - Les noms de produits sont parfois fusionnés sur plusieurs cellule - Je crois qu'il faudrait extraire le nom du produit et la quantité et les stocker temporairement car sinon ça recopie la fusion (ou peut-être il y a un autre truc)

Produits 72-BUMP-011-A 72-BUMP-012-A
Quantité 2 2


Est-ce clair ou faisable?

Merci

[Kimy_Ire]

Bonjour straipe,

Une petite macro personnalisée comme celle-ci devrait répondre à ton besoin il me semble :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Sub Recherche()
Dim oRng As Range
Dim i As Integer, n As Integer
Dim oProd As Range, oCell As Range
Dim oTable() As String
 
With Worksheets("Feuil1")
    Set oRng = .Range("A1")
    For i = 0 To .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        If oRng.Offset(i, 0) = "tablette" Or oRng.Offset(i, 0) = "produits" Then
            If .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft).Column >= oRng.Offset(i, 1).Column Then
                Set oProd = Range(oRng.Offset(i, 1), .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft))
                For Each oCell In oProd
                    If oCell <> "" Then
                        n = n + 1
                        ReDim Preserve oTable(1 To 2, 1 To n)
                        oTable(1, n) = oCell
                        oTable(2, n) = oCell.Offset(1, 0)
                    End If
                Next oCell
            End If
        End If
    Next i
End With
 
With Worksheets("Feuil2")
    Set oRng = .Cells(.Rows.Count, 1).End(xlUp)
    For i = LBound(oTable, 2) To UBound(oTable, 2)
        oRng.Offset(i, 0) = oTable(1, i)
        oRng.Offset(i, 1) = oTable(2, i)
    Next i
End With
 
End Sub

Il y a surement plus simple pour autant !
Je te laisse adapter !
N'hésite pas à revenir vers moi !

Cordialement,
Kimy

[straipe]

Merci beaucoup,

J'ai mis le code dans mon bouton qui est sur la Feuil7 et j'ai modifié le code pour que ça prenne les données de ma Feuil5 (et mettre les résultats dans Feuil6)- et ça stop sur cette ligne: With Worksheets("Feuil5")

L'indice n'apartient pas à la sélection

Des idées?

Merci encore

[Kimy_Ire]

Je t'ai mis des commentaires afin que tu puisses adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
 
Sub Recherche()
'Déclaration des variables
Dim oRng As Range
Dim i As Integer, n As Integer
Dim oProd As Range, oCell As Range
Dim oTable() As String
 
'Avec Feuil1 (feuille de données)
With Worksheets("Feuil1")
    'On se place sur A1
    Set oRng = .Range("A1")
    'On parcours de A1 à la dernière ligne non-vide
    For i = 0 To .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        'Si on trouve "tablette" ou "produits" (on peut enlever le LCase si souhaité)
        If LCase(oRng.Offset(i, 0)) = "tablette" Or LCase(oRng.Offset(i, 0)) = "produits" Then
            'On vérifie qu'on a des éléments à sa droite
            If .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft).Column >= oRng.Offset(i, 1).Column Then
                'Si oui, on récupère la range des valeurs
                Set oProd = Range(oRng.Offset(i, 1), .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft))
                'qu'on parcours.
                For Each oCell In oProd
                    'Si on trouve quelque chose
                    If oCell <> "" Then
                        n = n + 1
                        'on sauvegarde les éléments.
                        ReDim Preserve oTable(1 To 2, 1 To n)
                        oTable(1, n) = oCell
                        oTable(2, n) = oCell.Offset(1, 0)
                    End If
                Next oCell
            End If
        End If
    Next i
End With
 
'Avec Feuil2 (feuille où l'on déplace les données)
With Worksheets("Feuil2")
    'On se place après la dernière cellule non-vide de la colonne 1
    Set oRng = .Cells(.Rows.Count, 1).End(xlUp)
    'et on y écrit les résultats.
    For i = LBound(oTable, 2) To UBound(oTable, 2)
        oRng.Offset(i, 0) = oTable(1, i)
        oRng.Offset(i, 1) = oTable(2, i)
    Next i
End With
 
End Sub

J'attends ton retour !

Cordialement,
Kimy

[straipe]

Merci de ta patience et les commentaires, je vais te mettre une autre photo pour être sur qu'on parle de la même chose Mes données sont dans la Feuil5 - J'ai un bouton MAJ sur la Feuil7, et le résultat en appuyant sur le bouton va aller dans la Feuil6

[Kimy_Ire]

C'est soit With Feuil5 puisque c'est une Worksheets soit With Worksheets("IFX-2016-blablabla") pour lui donner son nom.

[straipe]

Mon erreur, j'ai remplacer le Feuil par les noms des Feuilles et je suis capable d'avancer plus. Dans la 2e partie du code, je dois mettre les données dans ce format - Je crois que le code ne serait pas adapté à ma situation dans ce cas?

merci