Résultat selon filtre vba excel

[matrix]

Bonjour,

Je voudrais filtrer des données de la feuille "Master" vers "RÉSULTAT FINAL" selon la valeur du textbox2 pour la colonne F ainsi que de la valeur TextBox1 pour la colonne G.

Bien entendu, la valeur du textbox doit filtrer les données >= .

Une fois fait, dans la feuille "RÉSULTAT FINAL", Colonne B, se trouve des numéros X. Je voudrais qu’entre chaque numéro X différent, il ajoute une ligne en dessous et dans la ligne vide, colonne B, il inscrit "Total" & Numéro X qui ce trouve au-dessus ainsi que dans la colonne G, la somme de tous les montants qui ont rapport avec montant X.

Ex: S'il y a 2 lignes avec le numéro 10000 dans la colonne B et que les montants de la colonne G sont 15 et 25, en dessous des 2 montant du numéro de la colonne B en question auront comme réponse: Total 10000 (colonneB) et 40 (colonne G)

Un exemple se trouve dans mon fichier feuille "RÉSULTAT FINAL" ligne 3.

Voici le script que j'ai jusqu'à maintenant:

Private Sub CommandButton1_Click()

Dim i%, j%
 
'Trier le nombre de caisses
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 6) > TextBox2.Text Or Cells(i, 6) = TextBox2.Text Then Rows(i).Copy Sheets("RÉSULTAT FINAL").Cells(Rows.Count, 1).End(xlUp)(2)
Next


'Trier par colonne B
Sheets("RÉSULTAT FINAL").Select
    Columns("A:G").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A2").Select
    
UserForm1.Hide

End Sub

Merci pour votre aide

 

[PMO2]

Re : Résultat selon filtre vba excel

Bonjour,

Ci-dessous, le code modifié de Private Sub CommandButton1_Click()

'### Noms des feuilles à adapter ###
Const SOURCE As String = "MASTER"
Const DEST As String = "RÉSULTAT FINAL"
'###################################

Private Sub CommandButton1_Click()
Dim Smaster As Worksheet
Dim Sfinal As Worksheet
Dim R As Range
Dim var
Dim f#
Dim g#
Dim i&
Dim j&

On Error Resume Next
Set Smaster = Sheets(SOURCE)
If Err <> 0 Then
  MsgBox "La feuille " & SOURCE & " est introuvable."
  Me.Hide
  Exit Sub
End If
Set Sfinal = Sheets(DEST)
If Err <> 0 Then
  MsgBox "La feuille " & DEST & " est introuvable."
  Me.Hide
  Exit Sub
End If
Err.Clear
On Error GoTo Erreur
Sfinal.Cells.Delete
Set R = Smaster.UsedRange
If R.Rows.Count < 3 Then
  MsgBox "Il n'y a qu'une seule ligne de données."
  Me.Hide
  Exit Sub
End If
Application.ScreenUpdating = False
var = R
R.Copy
With Sfinal
  .Activate
  .[a1].Select
  .Paste
End With
Application.CutCopyMode = False
f# = CDbl(TextBox2)
g# = CDbl(TextBox1)
For i& = 2 To UBound(var, 1)
  If var(i&, 6) < f# Or var(i&, 7) < g# Then
    For j& = 1 To UBound(var, 2)
      var(i&, j&) = ""
    Next j&
  End If
Next i&
With Sfinal
  Set R = .Range(R.Address)
  R = var
  R.Sort Key1:=.[b1], Order1:=xlAscending, Header:=xlYes
  Set R = .Range("a1:g" & .[a65536].End(xlUp).Row & "")
  R.Select
  R.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
      Replace:=True
  Set R = .Range("a1:g" & .[b65536].End(xlUp).Row & "")
  var = R
  .Cells.EntireRow.AutoFit
  For i& = 2 To UBound(var, 1)
    If InStr(1, (var(i&, 2)), "Total") Then
      .Range("g" & i& & "").Font.Bold = True
    End If
  Next i&
  R = var
  .Range("b" & UBound(var, 1) & "") = "Grand Total"
  .Range("b" & UBound(var, 1) & ":g" & UBound(var, 1) & "").Font.ColorIndex = 5
End With
Erreur:
Sfinal.[a1].Select
Application.Goto Reference:="R1C1", Scroll:=True
Me.Hide
If Err <> 0 Then
  MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
  Sfinal.Cells.Delete
End If
Application.ScreenUpdating = True
End Sub

Cordialement.

PMO
Patrick Morange

 

[matrix]

Re : Résultat selon filtre vba excel

Super merci,

Est-ce qu'il est possible d'ajouter dans le script ex: si dans le textbox 2 de la colonne G il est inscrit 300, qu'il cherche les 300 et plus comme présentement, mais aussi dans le négatif, donc -300 en montant dans le négatif bien entendu (ex: -300, -301 etc.)

La même chose pour le textbox1 de la colonne F.

Merci

 

[PMO2]

Re : Résultat selon filtre vba excel

Bonjour,

Modification du code pour obtenir les valeurs positivement égales ou supérieures OU
négativement égales ou inférieures aux valeurs retenues en TextBox1 ou en TextBox2.
Changez la ligne de code
If var(i&, 6) < f# Or var(i&, 7) < g# Then

par
If Abs(var(i&, 6)) < f# Or Abs(var(i&, 7)) < g# Then

Cordialement.

PMO
Patrick Morange

 

[matrix]

Re : Résultat selon filtre vba excel

C'est parfait.

Merci pour ton aide.