Discussion :

[Gatche]

Bonjour,

Après avoir cherché, peut être mal, des heures durant sur plusieurs forums d'aide, je viens vers vous pour m'aider à trouver mes problemes de script VBA.

Excusez sans doute ma façon d'expliquer laborieuse. Je suis en stage après une reconversion professionnelle. J'ai déjà appris certains langages de programmation, mais je suis perdue avec VBA

J'ai un tableau de données dans lequel j'ai fait une recherche multicritere des nouvelles entreprises.

Je voudrais réaliser une macro qui à chaque fois que le critère nouvelle entreprise apparaisse dans la colonne (CQ), aille chercher le nom de cette entreprise dans une autre colonne. Puis copie le nom de toutes les entreprises trouvées sur une nouvelle feuille.

Il y a sans doute des tonnes d'erreur dans ma macro, mais déjà première question : comment copier coller juste la chaine de caractères d'une cellule.

Petite info: le fichier a été créé en version japonaise.

Voici ma macro:

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
Sub New_customers()
 
'Research of new customers
 
Dim New_customer As String 'Declare la variable Nouveau client
Dim Ligne As Range 'Declare la variable ligne
Dim Limite As Integer 'Declare la variable limite
Dim Liste As Integer 'Declare la variable liste
Limite = 100
Liste = 1
 
Sheets("JD NET 0718").Select
Range("CQ3").Select
While ActiveCell.Value <> "New_customer" 'recherche la valeur dans la cellule active
        ActiveCell.Offset(1, 0).Select 'decale la ligne d'1 ligne vers le bas
 
 
        If ActiveCell.Value = "New_customer" Then 'si la cellule contient la valeur New_customer
        Set Ligne = Rows(ActiveCell.Row) 'selectionne la ligne correspondante
        New_customer = Range("C", Ligne).Copy 'copie la valeur de la colonne C dans la ligne correspondante
 
 
        Sheets("Feuil1").Select
 
       Range("B", Liste).Select 'selection de la cellule sur la nouvelle feuille a ecrire
        Newcustomer.Paste
 
 
        Liste = Liste + 1
 
        End If
 
        Limite = Limite - 1
 
Wend

[Invité]

Bonjour,

Une solution possible adaptée d'un code de Jacques BOISGONTIER dans cette discussion manipulation-tableau-vba-excel-2016-a
Nb : Pour Philippe TULLIEZ : Au cas où tu lirais cette discussion, j'ai prévu également d'essayer ta méthode.

Le résultat est déversé dans la colonne B uniquement pour respecter le code d'origine.

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 New_customers()
 
' Une adaptation du code FiltreColonnes de Jacques BOISGONTIER
 
Dim MatriceSource As Variant
Dim MatriceFiltree As Variant
Dim ShCible As Worksheet
Dim I As Long
 
 
    MatriceSource = Sheets("JD NET 0718").UsedRange
    MatriceFiltree = FiltreArrayCol_JB(MatriceSource, Array(3, 95))     ' on prend les colonnes 3, 95
    Set ShCible = Sheets.Add
 
    With ShCible
         .Range("B1").Resize(UBound(MatriceFiltree), UBound(MatriceFiltree, 2)) = MatriceFiltree
         For I = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
             If .Cells(I, 3) <> "New_customer" Then .Cells(I, 3).EntireRow.Delete
         Next I
        ' .Columns(3).Clear ' Pour supprimer la colonne New_customer
    End With
 
 
    Set ShCible = Nothing
 
End Sub
 
Function FiltreArrayCol_JB(Tableau As Variant, ColResult As Variant)
 
' De Jacques BOISGONTIER
 
Dim Decal As Long, I As Long, C As Long
Dim MatriceResultante()
 
    ReDim MatriceResultante(LBound(Tableau) To UBound(Tableau), 1 To UBound(ColResult) - LBound(ColResult) + 1)
    Decal = 1 - LBound(ColResult)
 
    For I = LBound(Tableau, 1) To UBound(Tableau, 1)
      For C = LBound(ColResult) To UBound(ColResult)
        MatriceResultante(I, C + Decal) = Tableau(I, ColResult(C))
      Next C
    Next I
 
    FiltreArrayCol_JB = MatriceResultante
 
End Function

[Gatche]

Bonjour,

Je vous remercie beaucoup. Ca fonctionne tres bien.

Cependant mon fichier plante, car j'ai beaucoup de donnees a traiter.

Une idee?

[Invité]

C'est un peu contradictoire !

Combien de lignes, combien de colonnes ?

[patricktoulon]

re
bonjour

J'ai un tableau de données dans lequel j'ai fait une recherche multicritere des nouvelles entreprises.

Je voudrais réaliser une macro qui à chaque fois que le critère nouvelle entreprise apparaisse dans la colonne (CQ), aille chercher le nom de cette entreprise dans une autre colonne. Puis copie le nom de toutes les entreprises trouvées sur une nouvelle feuille.

un simple filtre sur la colonne "CQ" ne suffirait il pas ? de cette maniere tu les aurais tous d'un coup tes "new_customer"

[Invité]

Et là en remplaçant uniquement la procédure ?

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
 
Sub New_customers()
 
' Une adaptation du code FiltreColonnes de Jacques BOISGONTIER
 
Dim MatriceSource As Variant
Dim MatriceFiltree As Variant
Dim ShCible As Worksheet
Dim I As Long
 
 
    MatriceSource = Sheets("JD NET 0718").UsedRange
    MatriceFiltree = FiltreArrayCol_JB(MatriceSource, Array(3, 95))     ' on prend les colonnes 3, 95
    Set ShCible = Sheets.Add
 
    With ShCible
         .Range("B1").Resize(UBound(MatriceFiltree), UBound(MatriceFiltree, 2)) = MatriceFiltree
         For I = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
             If .Cells(I, 3) <> "New_customer" Then .Cells(I, 3).EntireRow.Delete
         Next I
        ' .Columns(3).Clear ' Pour supprimer la colonne New_customer
    End With
 
    Erase MatriceSource
    Erase MatriceFiltree
 
    Set ShCible = Nothing
 
End Sub

[Gatche]

Je vois les resultats s'afficher mais ensuite excel plante. Je precise que mon fichier fait 40 Mo.
J'ai un cachier des charges precis de reports a faire, et je dois au maximum automatiser les taches, pour etablir un report mensuel. Je suis un peu perdue sur l'automatisation.

J'essayerai demain le nouveau script (decalage horaire oblige). Je vous remercie encore de votre aide.