Dim ncol% 'mémorise la variable
Private Sub UserForm_Initialize()
TextBox1_Change 'lance la macro
ListBox1.ColumnCount = ncol
ListBox1.ColumnWidths = "30;70;130;60;60;70;70;60;50;70;50"
ListBox1.ColumnHeads = True 'affiche les en-têtes
End Sub
Private Sub TextBox1_Change()
Dim f As Worksheet, i&, j%
Set f = Sheets("Filtre")
f.Cells.Clear 'RAZ
ThisWorkbook.Names.Add "TB", IIf(TextBox1 = "", "*", TextBox1) 'nom défini
With Sheets("Suivis_Facture").[A3].CurrentRegion
ncol = .Columns.Count
.Cells(2, ncol + 2) = "=ISNUMBER(SEARCH(TB,C4))" 'formule à adapter éventuellement
.AdvancedFilter xlFilterCopy, .Cells(1, ncol + 2).Resize(2), f.[A1].Resize(, ncol) 'filtre avancé
.Cells(2, ncol + 2) = ""
End With
With f.UsedRange
With .Columns(4).Resize(, 7)
.Replace ",", ".", xlPart 'convertit les textes en nombres
.NumberFormat = "#,###.00"
End With
If .Rows.Count = 1 Then
ListBox1.RowSource = ""
Else
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
End If
TextBox2 = Format(Application.Sum(.Columns(4)), "#,###.00")
End With
End Sub
merci beaucoup cela et très professionnelle,je n'ai pas de la chance pour convertir car les nombres texte venant d'un autre userform,je vais essayé de vous envoyer mon fichier origine pour voir,c'est un facturier.Bonjour yahya.be, JB,
En remplissant la ListBox via la propriété RowSource la propriété ColumnHeads permet d'afficher les en-têtes :
Fichier joint - je l'ai épuré pour qu'il pèse moins lourd...VB:Dim ncol% 'mémorise la variable Private Sub UserForm_Initialize() TextBox1_Change 'lance la macro ListBox1.ColumnCount = ncol ListBox1.ColumnWidths = "30;70;130;60;60;70;70;60;50;70;50" ListBox1.ColumnHeads = True 'affiche les en-têtes End Sub Private Sub TextBox1_Change() Dim f As Worksheet, i&, j% Set f = Sheets("Filtre") f.Cells.Clear 'RAZ ThisWorkbook.Names.Add "TB", IIf(TextBox1 = "", "*", TextBox1) 'nom défini With Sheets("Suivis_Facture").[A3].CurrentRegion ncol = .Columns.Count .Cells(2, ncol + 2) = "=ISNUMBER(SEARCH(TB,C4))" 'formule à adapter éventuellement .AdvancedFilter xlFilterCopy, .Cells(1, ncol + 2).Resize(2), f.[A1].Resize(, ncol) 'filtre avancé .Cells(2, ncol + 2) = "" End With With f.UsedRange With .Columns(4).Resize(, 7) .Replace ",", ".", xlPart 'convertit les textes en nombres .NumberFormat = "#,###.00" End With If .Rows.Count = 1 Then ListBox1.RowSource = "" Else ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) End If TextBox2 = Format(Application.Sum(.Columns(4)), "#,###.00") End With End Sub
A+
Si l'on s'y prend correctement les nombres seront bien des nombres, on attend votre fichier avec l'autre UserForm.je n'ai pas de la chance pour convertir car les nombres texte venant d'un autre userform
BonsoirSi l'on s'y prend correctement les nombres seront bien des nombres, on attend votre fichier avec l'autre UserForm.
Option Compare Text
Dim f, RngBD, ColRecherche
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set d = CreateObject("Scripting.Dictionary")
Set RngBD = f.[A1].CurrentRegion.Offset(1)
ColRecherche = 3
d("*") = ""
For i = 1 To RngBD.Rows.Count
clé = RngBD.Cells(i, ColRecherche): d(clé) = ""
Next i
Me.ComboBox1.List = d.keys ' liste des professions sans doublons
Me.ListBox1.ColumnCount = RngBD.Columns.Count
Me.ListBox1.ColumnWidths = "20;50;90;60;50;50;50;50;50;50;50" ' à adapter
Me.ListBox1.ColumnHeads = True
ComboBox1_click
End Sub
Private Sub ComboBox1_click()
Set f2 = Sheets("filtre")
f2.Cells.Clear
f2.[Z1] = RngBD.Offset(-1).Cells(1, ColRecherche): f2.[Z2] = Me.ComboBox1
f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f2.[Z1:Z2], _
CopyToRange:=f2.[A1], Unique:=False
Set RngFiltre = f2.[A1].CurrentRegion.Offset(1).Resize(f2.[A1].CurrentRegion.Rows.Count - 1)
Me.ListBox1.RowSource = RngFiltre.Address(External:=True)
Me.TextBox2 = Format(Application.Sum(Application.Index(RngFiltre, , 4)), "0000.00")
Me.TextBox3 = Format(Application.Sum(Application.Index(RngFiltre, , 10)), "0000.00")
Qu'à cela ne tienne, on peut convertir les textes en nombres avec cette macro :malheureusement mon fichier est un peu volumineux et qu'il ne se télécharge plus
Sub Convertir()
With Sheets("Suivis_Facture").[A3].CurrentRegion.Offset(1).Columns(4).Resize(, 7) 'colonnes D:J
If Evaluate("SUM(-ISTEXT(" & .Address & "))") = 0 Then Exit Sub
MsgBox "Conversion des textes en nombres en colonnes D:J..."
Dim t, tablo, ncol%, i&, j%, x$
t = Timer
tablo = .Value 'matrice, plus rapide
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo) - 1
For j = 1 To ncol
x = CStr(tablo(i, j))
If IsNumeric(x) Then tablo(i, j) = CDbl(x)
Next j, i
If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
.Resize(.Rows.Count - 1) = tablo
MsgBox "Conversion réalisée en " & Format(Timer - t, "0.00 \s")
End With
End Sub
ah oui je vais garder ce macro,c'est très intéressant, merci à vousBonjour yahya.be, JB,
Qu'à cela ne tienne, on peut convertir les textes en nombres avec cette macro :
Fichier (2), pour tester j'ai recopié le tableau A4:K12 sur 90 000 lignes, la macro s'exécute en 2 secondes.VB:Sub Convertir() With Sheets("Suivis_Facture").[A3].CurrentRegion.Offset(1).Columns(4).Resize(, 7) 'colonnes D:J If Evaluate("SUM(-ISTEXT(" & .Address & "))") = 0 Then Exit Sub MsgBox "Conversion des textes en nombres en colonnes D:J..." Dim t, tablo, ncol%, i&, j%, x$ t = Timer tablo = .Value 'matrice, plus rapide ncol = UBound(tablo, 2) For i = 1 To UBound(tablo) - 1 For j = 1 To ncol x = CStr(tablo(i, j)) If IsNumeric(x) Then tablo(i, j) = CDbl(x) Next j, i If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée .Resize(.Rows.Count - 1) = tablo MsgBox "Conversion réalisée en " & Format(Timer - t, "0.00 \s") End With End Sub
A+