Autres Amélioré macro

abdernino1985 · 15 Août 2019

Bonjour le forum,
j'ai un fichier qui contient plusieurs macros je voudrais améliorer tout ça
1- une macro pour supprime ligne et pour les colonnes je voudrais mettre ça dans une seule macro
2- macro fusion qui m'affiche un message erreur ci-jointe capture d'écran du message
3- concaténation d'Iris je veux qu'il arrête la copie a la dernière ligne et éviter "Valeur"
Merci

Staple1600 · 16 Août 2019

Bonjour le fil, abdernino

Une proposition pour le point 1)
(je te laisse tester sur ton fichier, car chez moi ton fichier fait tousser mon Excel, j'ai donc testé sur un fichier de test que j'ai créé pour l'occasion))

VB:

Sub SupprLig_et_Col()
Dim i&
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        For i = 1 To ActiveSheet.UsedRange.Columns.Count
        If .CountA(Columns(i)) = 0 Then Columns(i).Delete
        Next
    .Calculation = xlCalculationAutomatic
End With
End Sub

abdernino1985 · 16 Août 2019

Staple1600 à dit:
Bonjour le fil, abdernino

Une proposition pour le point 1)
(je te laisse tester sur ton fichier, car chez moi ton fichier fait tousser mon Excel, j'ai donc testé sur un fichier de test que j'ai créé pour l'occasion))

VB:

Sub SupprLig_et_Col() Dim i& With Application .ScreenUpdating = False .Calculation = xlCalculationManual Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete For i = 1 To ActiveSheet.UsedRange.Columns.Count If .CountA(Columns(i)) = 0 Then Columns(i).Delete Next .Calculation = xlCalculationAutomatic End With End Sub

Merci beaucoup ,
je suis novice et je veux apprendre

Staple1600 · 16 Août 2019

Re

Trés bien.
Alors qu'a donné le résultat du test de la macro de mon précédent message?

abdernino1985 · 16 Août 2019

Staple1600 à dit:
Sub SupprLig_et_Col() Dim i& With Application .ScreenUpdating = False .Calculation = xlCalculationManual Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete For i = 1 To ActiveSheet.UsedRange.Columns.Count If .CountA(Columns(i)) = 0 Then Columns(i).Delete Next .Calculation = xlCalculationAutomatic End With End Sub

Bonjour et merci
j'ai essayer et ca marche pour 1 étape moi après avoir supprimer les ligne et colonne vide je fait fusionné après je supprime encore fois les colonne vide est la ça marche pas.
si tu veux savoir pourquoi je fusionne parce que le fichier qu'on me transmet est plein de colonne et ligne inutile alors je doit le nettoyer avant traitement

Staple1600 · 16 Août 2019

Re,

Comme précédemment évoqué

je te laisse tester sur ton fichier, car chez moi ton fichier fait tousser mon Excel

En clair, ton classeur crash mon Excel, donc je ne peux faire d'autres tests sans que cela plante.

abdernino1985 · 16 Août 2019

Staple1600 à dit:
Re,

Comme précédemment évoqué

En clair, ton classeur crash mon Excel, donc je ne peux faire d'autres tests sans que cela plante.

Pas grave meeci beaucoup

abdernino1985 · 17 Août 2019

abdernino1985 à dit:
Pas grave meeci beaucoup

Bonjour le forum,
C'est le calcul s.a qui fait mon fichier rame trop, mais si je désactive le calcul les formule ne marche pas alors comment faire?

Staple1600 · 17 Août 2019

Bonjour le fil, abdernino1985

Si toi, tu peux ouvrir ton classeur, alors copies/colles sur le forum le code VBA
Notamment les deux macros qui correspondent à ces deux actions

2- macro fusion qui m'affiche un message erreur ci-jointe capture d'écran du message
3- concaténation d'Iris je veux qu'il arrête la copie a la dernière ligne et éviter "Valeur"

Cela permettra déjà qu'on puisse voir ce qu'on peut modifer dans le code VBA existant.

Dranreb · 17 Août 2019

Bonjour.
Moi j'ai pu l'ouvrir et voir que ce ne sont que des macro sorties brut de l'enregistreur.
Alors je préfèrerais au contraire voir les données telles qu'elles sont avant quelque traitement que ce soit et ce qu'on veut comme résultat correspondant.

patricktoulon · 17 Août 2019

bonjour
ouvrez le fichier en restant appuyé sur "ESC"
cela dit comme j'ai pu l'ouvrir
si ca peut aider
voici le code module 1

VB:

Sub supp()
Dim i
Worksheets("Iris").Activate
For i = [A65000].End(xlUp).Row To 10 Step -1
    If Cells(i, 1) = "" Then Cells(i, 1).EntireRow.Delete
Next i
End Sub

Sub sup_col_vides()
Dim c
Worksheets("Iris").Activate
For c = 40 To 1 Step -1
If Cells(65536, c).End(xlUp).Row = 1 Then Cells(1, c).EntireColumn.Delete
Next c
End Sub

Sub fusio_Iris()
'
' fusio_Iris Macro
'

'
    Sheets("Iris").Select
    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Columns("A:V").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    
    
  
    End Sub

Sub concatener_Iris()
'
' concatener_Iris Macro
'

'
    Sheets("Iris").Select
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],5)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C1096")
    Range("C2:C1096").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-14]&"" ""&RC[-3]"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q1097")
    Range("Q2:Q1097").Select
    Columns("Q:Q").EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("B:B").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Range("R1").Select
    ActiveSheet.Paste
    Sheets("Menu").Select
End Sub
Sub concatener_liquidation()
'
' concatener_liquidation Macro
'

'
    ActiveCell.FormulaR1C1 = "ref_con"
    Range("N11").Select
    Sheets("Liqui").Select
    Range("N11").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEN(VALUE(RC[-12]))<4,""0""&RC[-12]&"" ""&RC[-2],RC[-12]&"" ""&RC[-2])"
    Range("N11").Select
    Selection.AutoFill Destination:=Range("N11:N4700"), Type:=xlFillDefault
    Range("N11:N4700").Select
    ActiveWindow.ScrollRow = 4675
    ActiveWindow.ScrollRow = 4545
    ActiveWindow.ScrollRow = 4328
    ActiveWindow.ScrollRow = 3995
    ActiveWindow.ScrollRow = 3517
    ActiveWindow.ScrollRow = 3069
    ActiveWindow.ScrollRow = 2707
    ActiveWindow.ScrollRow = 2345
    ActiveWindow.ScrollRow = 2056
    ActiveWindow.ScrollRow = 1810
    ActiveWindow.ScrollRow = 1593
    ActiveWindow.ScrollRow = 1434
    ActiveWindow.ScrollRow = 1318
    ActiveWindow.ScrollRow = 1260
    ActiveWindow.ScrollRow = 1246
    ActiveWindow.ScrollRow = 1217
    ActiveWindow.ScrollRow = 1028
    ActiveWindow.ScrollRow = 725
    ActiveWindow.ScrollRow = 363
    ActiveWindow.ScrollRow = 1
    Rows("10:10").Select
    Range("C10").Activate
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveSheet.Range("$A$10:$N$7000").AutoFilter Field:=14, Criteria1:= _
        "#VALEUR!"
    Range("N1106").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.Range("$A$10:$N$7000").AutoFilter Field:=14
    Sheets("Menu").Select
    Range("E11").Select
End Sub

voici le code module 2

Code:

Sub fusio_Iris()
'
' fusio_Iris Macro
'

'
    Rows("1:5").Select
    Range("A5").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("A:AA").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    End Sub

voici le code module 3

Code:

Sub recherchev()
'
' recherchev Macro
'

'
    Range("O10").Select
    ActiveCell.FormulaR1C1 = "recherchev"
    Range("O11").Select
    Sheets("liqui").Select
    Range("O11").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],base_iris,2,0),"""")"
    Range("O11").Select
    Selection.AutoFill Destination:=Range("O11:O1105")
    Range("O11:O1105").Select
    Columns("O:O").EntireColumn.AutoFit
End Sub

voici le code userform

Code:

Private Sub CommandButton1_Click() 'bouton "Valider"
Dim O As Worksheet 'déclare la variable O (onglet)
Dim DL As Integer
Dim PL As Range
Dim TC() As Variant
Dim TEST As Boolean

Set O = Worksheets("Iris") 'définit l'onglet O
Set PL = O.Range("A1")
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row
TC = Array("030110", "030112", "030113", "030114")
Application.ScreenUpdating = False
If OptionButton1.Value = True Then
    For i = 2 To DL
        If CStr(O.Cells(i, "F")) <> "100110" Then Set PL = IIf(PL.Cells.Count = 1, O.Rows(i), Application.Union(PL, O.Rows(i)))
    Next i
    PL.Delete
End If
If OptionButton2.Value = True Then
    For i = 2 To DL
        TEST = False
        For J = 0 To 3
            If CStr(O.Cells(i, "F")) = TC(J) Then TEST = True
        Next J
        If TEST = False Then Set PL = IIf(PL.Cells.Count = 1, O.Rows(i), Application.Union(PL, O.Rows(i)))
    Next i
    PL.Delete
End If
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub CommandButton2_Click() 'bouton "Sortir"
Unload Me 'vide et ferme l'UserForm
End Sub

Private Sub UserForm_Click()

End Sub

Staple1600 · 17 Août 2019

Re, Bonjour patricktoulon, Dranreb

patricktoulon
Merci pour la publication du code VBA.

PS: Je n'ai pas pu l'ouvrir parce qu'actuellement sous Excel 2003, j'ai donc converti en *.xls
J'ouvre systématiquement les classeurs issus du web sans activer les macros
Aprés conversion le *.xls fait plus de 4mo, et il plante systématiquement mon Excel.
J'ai juste eu le temps de copier la macro supp et sup_col_vides, d'où mon premier message.

abdernino1985 · 17 Août 2019

Bonjour le forum ;
Voilà j'ai désactivé calcul automatique , alors maintenant le fichier est accessible 1 la macro suppression colonne et ligne marche très plus besoin de fusion.
2 pour la macro concaténée Iris elle marche très bien moi j'ai besoin d'insérer une colonne en C et extraire les 5 premiers chiffres N° Sinistre, et après concaténer la colonne insérer avec total sur la dernière colonne vide .
3 pour la macro recherche v elle marche très mais dans la mesure du possible je voudrais que la copie de cette formule si RC>0
Merci beaucoup

Staple1600 · 17 Août 2019

Bonjour le fil,

Là, je peux ouvrir le fichier sans qu'Excel ne plante pas.
Cela me peremts de voir les données contenues et de te donner l'amical conseil suivant.
Pour être en "régle" avec la RGPD, ton fichier devrait être anonymisé
(voir la charte du forum => point sur les données confidentielles)

Pour ton besoin d'amélioration, un début possible

VB:

Sub concatener_iris_bis()
Dim DL&
Set f = Sheets("Iris")
DL = f.Cells(Rows.Count, "B").End(3).Row
f.Columns(4).Insert
f.Range("D7:D" & DL) = "=LEFT(RC[-2],5)"
f.Range("D7:D" & DL) = f.Range("D7:D" & DL).Value
'à continuer sur le même principe
End Sub

Effectuez une recherche sur Excel Downloads...

Autres Amélioré macro

abdernino1985

XLDnaute Junior

Pièces jointes

abdernino1985

Staple1600

XLDnaute Barbatruc

abdernino1985

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

abdernino1985

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

abdernino1985

XLDnaute Junior

abdernino1985

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

abdernino1985

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums