Commande Find ou autre

Version imprimable

10/02/2016, 03h35
straipe

1 pièce(s) jointe(s)

Commande Find ou autre

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

Bonjour straipe,

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

Code:

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 ! :aie:
Je te laisse adapter !
N'hésite pas à revenir vers moi ! :ccool:

Cordialement,
Kimy

10/02/2016, 12h39
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

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

Code:

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 ! :ccool:

Cordialement,
Kimy

10/02/2016, 14h56
straipe

2 pièce(s) jointe(s)

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 Feuil6Pièce jointe 200456
10/02/2016, 15h12
Kimy_Ire

C'est soit With Feuil5 puisque c'est une Worksheets soit With Worksheets("IFX-2016-blablabla") pour lui donner son nom. ;)
10/02/2016, 15h12
straipe

1 pièce(s) jointe(s)

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

Pièce jointe 200463

Concernant ta deuxième difficulté, ne connaissant que la quantité, il faut changé comme ceci l'écriture de tes valeurs :

Code:

1
2
3
4
5
6
7
8
9
10
11
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)
 
'On ne déplace ici plus de 1 mais de 3 colonnes l'écriture des résultats.
        oRng.Offset(i, 3) = oTable(2, i)
    Next i
End With

10/02/2016, 15h37
straipe

Ce qui s'en va dans Feuil2 sous Nom Pièce, c'est l'information recueillie lorsque l'on trouve Tablette ou Produits + la Quantité sous QTY

La dernière modif me sort une erreur sous: For i = LBound(oTable, 2) To UBound(oTable, 2).
10/02/2016, 15h55
Kimy_Ire

... ce qui signifie que oTable est vide => et donc n'a rien trouvé.

Je t'ai fait quelque chose en fonction du tableau que tu m'as présenté.
Peux-tu poser un fichier exemple ? Ca sera plus simple que 15 000 posts consécutifs.

Tu peux essayer, au passage, de vérifier l'égalité If oRng.Offset(i, 0) = "Tablette" Or oRng.Offset(i, 0) = "Produits" Then qui doit être passante.
Pour moi, oRng.Offset(i, 0) parcours la colonne A.
10/02/2016, 16h17
straipe

1 pièce(s) jointe(s)

Je n'ai plus l'erreur, mais aucune valeur ne se transfère dans Résultats

Document Original - IFX-2016-01-11 - je l'ai modifié en MOD, mais si je serais capable de tout faire sans devoir modifier (MOD) ça serait génial. Je ne sais pas si on peut travailler avec les couleurs également. Car ce qui est en jaune, devrait être lu de haut en bas. Ex.: C18 + quantité C20 + quantité D18, D20, E18, E20 etc et repartir a H18 par la suite (feuille IFX)

merci

Boah... si tu avais un peu cherché dans ta feuille, tu aurais vu tes valeurs tout en bas (EDIT : je l'avais même mis en commentaire.).
Bref, voici :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
'Avec Feuil6 (feuille de résultats)
With Worksheets("Resultats")
    'On se place après la dernière cellule non-vide de la colonne 1
    Set oRng = .Cells(.Rows.Count, 2).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)
 
'On ne déplace ici plus de 1 mais de 3 colonnes l'écriture des résultats.
        oRng.Offset(i, 3) = oTable(2, i)
    Next i
End With

Je me base maintenant sur la colonne B. :ccool:

Cordialement,
Kimy

10/02/2016, 16h33
straipe

Désolé je n'avais pas descendu aussi bas :oops: Ça fonctionne #1. Vraiment super merci
10/02/2016, 16h40
Kimy_Ire

Et comme toujours, un forum n'est pas statique et ne sert pas qu'à toi. Ainsi lis ma signature et passe ce sujet en :resolu:.

Cordialement,
Kimy