VBA - Numérotation des cellules & recherche 2 colonnes + somme
Bonsoir,
Ma question se divise en deux parties. Je pourrai diviser le post en deux si nécessaire, mais les deux sont plus ou moins liées.
Le code actuel regroupe des informations renseignées en 'feuille 3' [Colonne A] à chaque fois qu'elles sont identiques et additionne les valeurs des surfaces indiquées en [Colonne E].
Ensuite, Excel recherche la valeur maximale renseignée en 'feuille 1' [Colonne AW] et créé, pour chaque initialement présente en feuille 3, le même nombre de lignes que la valeur maximale. Ensuite, il fusionne les cellules qui doivent l'être.
Maintenant, savez-vous comment je dois m'y prendre pour :
Premièrement :
- Numéroter les lignes en colonne F, en recommençant à 1 à chaque fois que la valeur indiquée en colonne A change. (Vous pourrez voir sur le document, pour chaque "ligne" en colonne A, il y aura "x" lignes en colonne F.
> Par exemple, si la valeur max est 3 (feuille 1 col "AW"), alors 3 lignes sont créées à chaque ligne initiale (feuille 3 col "A"] ; il faudra alors indiquer : "F3" : 1 ; "F4" : 2 ; "F5" : 3 ; "F6" : 1 ; "F7" : 2 ; "F8" : 3 ; etc.
Deuxièmement : (Ça va être violent à expliquer, si c'est flou je m'efforcerai de rendre ça plus clair)
- Effectuer une recherche sur deux colonnes : Rechercher toutes les valeur présentes en feuille 1 [Colonne AH] identique à chaque valeur renseignée en feuille 3 [Colonne A] ; pour chacune des correspondances trouvées en feuille 1 [Colonne AH] rechercher les correspondances entre feuille 3 [Colonne F] (là il y a "x" lignes à rechercher, ça risque de bloquer...) et feuille 1 [Colonne AW] et, à chaque fois, additionner les valeurs inscrites en feuille 1 [Colonne AY] et inscrire le résultat en feuille 3 [Colonne F] à la suite du numéro qui était déjà indiqué et qui a servi de référence pour la recherche.
Je crains de ne pas m'y prendre dans le bon sens, les fusions sont nécessaires (pour le rendu final), mais elles risquent de poser problème pour ce problème là...
Je vous remercie de votre attention,
Bonne soirée !
A plus tard
Bonjour,
Je n'ai pas le temps actuellement pour me pencher sur la 2e partie de ta demande.
La 1re partie ...
Macro dans le module2 avec appel de cette macro à la fin de celle du bouton Ok du formulaire...
ric
Bonsoir,
Merci d'avoir pris le temps de me répondre !
Le code que vous proposez fonctionne pour 3 lignes créées (sauf la dernière ligne), mais ne fonctionne plus s'il y a davantage de lignes (le nombre de lignes créées est variable
Pour le problème avec le nombre de lignes, j'ai simplement besoin de dupliquer cette partie du code :
If X < Dlig And X <= DligM And .Cells(X + 2, "A") = "" Then .Cells(X, "F").Offset(2, 0) = 3autant de fois que nécessaire, en l'adaptant, sachant que ça dépasse rarement 4.
C'est encore moi,
J'ai mis à jour mon document. Normalement, il ne devrait plus y avoir de problème vis à vis des dernières lignes, l'insertion des lignes est plus propre et le code a été réorganisé pour plus de clarté parce que ça commençait à s'éparpiller, comme à chaque fois.
J'ai finalement décidé d'éviter la fusion des lignes pour simplifier les codes à venir, parce que ça posait vraiment problème. J'ai beau le savoir, j'ai quand-même essayé.
Mais du coup, je ne sais plus comment faire pour numéroter les lignes comme vous l'avez fait, maintenant que les cellules ne sont plus fusionnées.
Après de multiples tentatives, je ne sais pas comment m'y prendre, la simple numérotation des lignes suit une logique que je ne doit pas comprendre...
Je peux numéroter jusqu'à 2, pas plus...
Voici le code en question :
Public Sub Numerotation()
'Recalculer le nombre de lignes maximum
lrws3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
ws3.Range(Cells(3, 6), Cells(lrws3, 6)).Value = 1
For u = lrws3 To 3 Step -1
If Cells(u, 1) = Cells(u - 1, 1).Value Then 'And Cells(u, 6).Value = 1 Then
Cells(u, 6).Value = Cells(u - 1, 6).Value + 1
End If
End SubEt une autre version de mon document en PJ.
En espérant que vous ayez une solution, ce qui est plus que probable.
Bonjour,
Un essai ...
Public Sub Numerotation()
Dim V As Byte
'Recalculer le nombre de lignes maximum
With ws3
LrWs3 = .Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne
For u = 2 To LrWs3 ' boucle sur la colonne A
For V = 1 To 33 ' boucle sur le nombre de cellules identiques en A ( de 1 à 33 cellules identiques possibles)
If .Cells(u + V, 1) = .Cells(u + V + 1, 1).Value Then ' test Ax et Ax+1
.Cells(u + V, 6).Value = V ' écrit en F
If u = LrWs3 - 1 Then Exit Sub ' si u = la dernière ligne -1, terminer la macro
Else ' si la première condition est fausse
.Cells(u + V, 6).Value = V ' écrire la dernière cellule du lot identique
u = u + V - 1 ' incrémenter U
If u = LrWs3 - 1 Then Exit Sub ' si U = la dernière ligne -1, terminer la macro
Exit For ' sors de la boucle V
End If
Next V
If u = LrWs3 Then Exit For ' si u = la dernière ligne, sors de la boucle u
Next u
End With
End Subric
Bonjour,
Le code que vous avez proposé fonctionne.
Merci pour les annotations qui expliquent clairement ce que chaque ligne du code fait ! C'est intéressant et ça me sera très utile pour la suite.
Je me retrouve maintenant face au gros du problème, qui va être probablement beaucoup plus compliqué à réaliser
A savoir :
Effectuer une recherche sur deux colonnes entre feuille 1 (Col AH + AW) et feuille 3 (Col A + F) .
Lorsque [feuille 3 Col A et feuille 1 Col AH] sont identique, alors, à chaque fois que [feuille 3 col F et feuille 1 col AW] sont identique alors faire la somme des valeurs. Et inscrire ces valeurs en feuille 3 colonne F, à la suite de des numérotations déjà faites.
Grâce à votre aide, j'ai une idée de la manière dont je dois m'y prendre pour faire des recherches sur plusieurs colonnes, mais je ne sais pas comment faire pour additionner ensuite les valeurs...
Je met mon document en pièce jointe avec le code intégré, vous verrez que tout fonctionne bien. Si ce n'est les formats de surface qui me rendent fou... Je l'ai déjà corrigé ailleurs, ce ne sera pas compliqué.
Si je parviens à trouver un moyen, je posterai une nouvelle version de mon document à la suite.
Bonne journée !
Merci beaucoup pour votre aide !
Bonsoir,
Pour le moment j'ai travaillé sur ce code-ci :
Option Explicit
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lrws As Long, lrws2 As Long, lrws3 As Long, lcws3 As Long, n As Long, n2 As Long
Dim rng As Range, Cell As Range, rng2 As Range, Cell2 As Range, rng3 As Range, Cell3 As Range, _
rng4 As Range, Cell4 As Range, plageEI As Range, re As Range, lRow As Long
Dim i2 As Integer, a As Integer, b As Integer, s As Integer, p As Integer, u As Integer, _
t As Integer, i As Integer, k As Integer, m As Integer
Dim V As Byte, q As Byte
Public j As IntegerSub Rech2colSum()
Dim u1 As Integer, plge As Range, a1 As Range, a2 As Range
Dim i1 As Integer, c As Variant
Set ws = Worksheets("CSV")
Set ws3 = Worksheets("VNEI (Impacts)")
lrws = ws.Cells(Rows.Count, 1).End(xlUp).Row
lrws3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
With ws3
For u1 = 2 To lrws3
For Each c In Range("A2:A" & lrws3)
If Not c = "" Then
With ws
Set plge = ws.Range("AH:AH" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
End With
With ws3
For i1 = 2 To lrws3
Set a1 = plge.Find(.Cells(i1, 1), LookAt:=xlWhole)
If Not a1 Is Nothing Then
a2 = a1.Offset(, 15) 'Num étude
Else
a2 = 0
End If
Next i1
End With
End If
If c = Cell(u1, 1) And c.Offset(0, 5) = a2 Then
MsgBox "j'ai trouvé"
End If
Next c
Next u1
End With
End SubJ'ai également essayé de faire fonctionner la fonction Sumifs, et continuerai plus tard. Pour le moment je ne vois pas bien comment m'en servir dans mon cas. Mais ça me semble une bonne option.
test = Application.WorksheetFunction.SumIfs(ws.Range("AY2:AY" & lrws), ws3.Range("A1:A" & lrws3), ws3.Range("F1:F" & lrws3), ws3.Range("AH1:AH" & lrws))Sinon, j'imagine peut-être passer par une concaténation de mes colonnes dans des variables, pour simplifier la recherche, sans vraiment d'idée pour les additions qui suivent...
Bonne soirée !
Bonjour,
J'ai finalement opté pour concaténer les infos, de manière à ne faire une recherche qu'entre deux colonnes.
J'ai ensuite essayé de faire la somme des valeurs issues de ces recherches, par différents moyens.
Deux codes ont donné un résultat, mais pas ce que j'attendais...
'______________________----------------------________________________
'Essai 1 => Fonctionne pas ; ne fait pas la somme
With ws3
'For b1 = 3 To lrws3
Set rang2 = .Range("O3:O" & lrws3)
For Each c In rang2
With ws
For a1 = 2 To lrws
c.Offset(, 1) = Application.SumIf(ws.Cells(a1, 52), c, ws.Cells(a1, 51))
Next a1
End With
Next
End With
'______________________----------------------________________________
'Essai 2 => Fonctionne pas ; ne fait la somme que pour la première valeur
With ws
Set rang1 = .Range("AZ2:AZ" & lrws)
End With
With ws3
Set rang2 = .Range("O3:O" & lrws3)
For Each c In rang2
c.Offset(, 1) = Application.SumIf(rang1.Columns(1), c, rang1.Columns(2))
Next
End WithJe continue dans mes essais et posterai la solution que j'ai trouvé, si j'en trouve.
En attendant, je joins mon document, dans le cas où vous auriez la méthode à appliquer !
Edit : Il y a visiblement un problème de format que je dois changer.
Bonne journée !
Mon deuxième test semble fonctionner, le problème provient encore du format.
Bonjour,
Voilà, ça fonctionne.
Il reste encore des erreurs par ci par là, mais elles n'ont pas de rapport avec ce que je cherchais à faire et seront corrigées plus tard.
Merci beaucoup pour votre aide !
J'ajoute mon document Excel en pièce jointe ; le code qui fonctionne est le suivant :
Sub RechSum()
Dim rang1 As Range, rang2 As Range
Dim c As Variant
Dim a1 As Integer
Set ws = Worksheets("CSV")
Set ws3 = Worksheets("VNEI (Impacts)")
lrws = ws.Cells(Rows.Count, 1).End(xlUp).Row
lrws3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
With ws
Set rang1 = .Range("AY2:AY" & lrws)
End With
With ws3
Set rang2 = .Range("O3:O" & lrws3)
For Each c In rang2
c.Offset(, 1) = Application.SumIf(rang1.Columns(1), c, rang1.Columns(2))
Next
End With
End SubBonne fin de journée