XL 2016 Transformer formule excel en VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

Bullrot

XLDnaute Junior
Bonjour à tous,

CODE : ADMIN
PASSWORD: ADMIN

Je reviens vers vous, pour une petite solution... J'ai fini mon tableau de projet (super 😀) mais le fichier est devenu super lent à cause du fait que chaque formule attend une mise à jour éventuelle. Il m'a été proposé de voir pour traduire mes formules en VBA.

J'ai commencé par FormulaR1C1 qui va appliquer la formule dans les lignes cibles. mais certaine cellule ne sont correctement retransmise dans le tableur

VB: 
Sub IER()
    Dim Wb As Workbook
    Set Wb = ThisWorkbook
    Dim sheetIER As Worksheet
    Set sheetIER = Wb.Worksheets("IER")
    Dim i As Integer
    Dim lastRow As Integer
    lastRow = getLastRow("P")
    For i = 7 To lastRow
    'display CDN
        sheetIER.Range("AJ" & i).FormulaR1C1 = "=IF(AND([@Colonne12]="""",[@Colonne13]=""""),"""",CONCATENATE([@DEPARTMENT],""_"",[@SERVICE],""_"",[@FUNCTION]))"
    'NUMBER CDN erreur à partir de SERVICE_FUNCTION_NUM[SERVICE]&SERVICE_FUNCTION_NUM[FUNCTION
        sheetIER.Range("Ak" & i).FormulaR1C1 = "=IFERROR(IF(AND([@Colonne12]="""",[@Colonne13]=""""),"""",CONCATENATE(Données_bulle_commune,SIT_CDN,""-"",INDEX(UNITE[A/B],MATCH([@DEPARTMENT],UNITE[TRIGRAME],0)),INDEX(SERVICE_FUNCTION_NUM[NUM_CDN],MATCH([@SERVICE]&[@FUNCTION],SERVICE_FUNCTION_NUM[SERVICE]&SERVICE_FUNCTION_NUM[FUNCTION],0)))),"""")"
    'PAGING ALL CDN
        sheetIER.Range("AM" & i).FormulaR1C1 = "=IF(AND([@Colonne12]="""",[@Colonne13]=""""),"""",""YES"")"
    'DISPLAY MDN
        sheetIER.Range("BU" & i).FormulaR1C1 = "=IF(AND([@Colonne50]="""",[@Colonne51]=""""),"""",CONCATENATE(Données!R4C6,"" "",[@Colonne53]))"
    'NUMBER MDN erreur à partir de SERVICE_FUNCTION_NUM[SERVICE]&SERVICE_FUNCTION_NUM[FUNCTION]
        sheetIER.Range("BV" & i).FormulaR1C1 = "=IFERROR(IF(AND([@Colonne50]="""",[@Colonne51]=""""),"""",CONCATENATE(Données_Mdn,SIT_MDN,INDEX(UNITE[A/B],MATCH([@DEPARTMENT],UNITE[TRIGRAME],0)),INDEX(SERVICE_FUNCTION_NUM[NUM_CDN],MATCH([@SERVICE]&[@FUNCTION], SERVICE_FUNCTION_NUM[SERVICE]&SERVICE_FUNCTION_NUM[FUNCTION],0)))),"""")"
    'PAGING MDN
        sheetIER.Range("BX" & i).FormulaR1C1 = "=IF(AND([@Colonne50]="""",[@Colonne51]=""""),"""",""YES"")"
    Next i
End Sub

Public Function getLastRow(colone As String) As Integer
    Dim Wb As Workbook
    Set Wb = ThisWorkbook
    Dim sheetIER As Worksheet
    Set sheetIER = Wb.Worksheets("IER")
    For ligne = 7 To 500    'sheetIER.UsedRange.Rows.Count
        Dim value As String
        value = sheetIER.Range(colone & ligne).value
        If value = "" Then
            getLastRow = ligne
            Exit Function
        End If
    Next ligne
    getLastRow = 500
End Function


Je sais pas comment simplifier chacune de mes formules en VBA
 

Pièces jointes

Trier par date Trier par votes
Re

Par exemple, j'ai regrouper dans un seul module, ce qui est relatif à l'effacement
VB: 
Sub ClrIER()
fClear Worksheets("IER"), "V7:AJ254,AL7:AL254,AM7:BU254,BW7:CR254"
End Sub
Sub ZeroiseUserInfo_Ciquer()
fClear Worksheets("IER"), "M7:U254"
End Sub
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
Sinon suggestion
Pour les emails
Puisque que c'est la même procédure
Je la rendrai paramétrable pour n'avoir qu'une seule procédure.
 
Vote positif 0 Vote négatif
Re

Ce qui pourrait donner un truc dans ce genre
(je te laisse tester)
VB: 
Sub mails_CDN()
EnvoiMails
End Sub
Sub mails_MDN()
EnvoiMails "MDN"
End Sub

Sub EnvoiMails(Optional Destinataires As String = "CDN")
    Dim ListeDest() 'variable dans tableau USERS
    Dim ListeService() 'variable dans tableau USERS
    Dim ListeDistribution() 'variable dans tableau USERS
    Dim i&, oMsgApp As Outlook.Application, oMsg As Outlook.MailItem
    Dim sListeDest$, sFichier$, sFichierExist$, BoxAttachments%, BoxPreviewMsg%
    BoxAttachments = MsgBox("Do you want an attachment?", vbQuestion + vbYesNoCancel + vbDefaultButton2, "Attachments?")
    If BoxAttachments = vbYes Then
        sFichier = Application.GetOpenFilename(, , "Sélect your file for send")
        sFichierExist = Dir(sFichier)
            If sFichierExist = "" Then
                BoxAttachments = vbNo
            End If
    ElseIf BoxAttachments = vbCancel Then
        Exit Sub
    End If
Set oMsgApp = New Outlook.Application
Select Case Destinataires
    Case "CDN"
    ListeDest() = Range("USERS[CDN MAIL]") 'variable dans tableau USERS
    ListeService() = Range("USERS[SERVICE MAIL UNCLASS]") 'variable dans tableau USERS
    ListeDistribution() = Range("USERS[DISTRIBUTION LIST UNCLASS]") 'variable dans tableau USERS
    Case "MDN"
    ListeDest() = Range("USERS[MAILBOX]") 'variable dans tableau USERS
    ListeService() = Range("USERS[SERVICE MAIL CLASS]") 'variable dans tableau USERS
    ListeDistribution() = Range("USERS[DISTRIBUTION LIST CLASS]") 'variable dans tableau USERS
End Select
    For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
        If ListeDest(i, 1) = "" Then
           GoTo nextI
        End If
        Set oMsg = oMsgApp.CreateItem(olMailItem) 'create new mail
        With oMsg
            '.To = sListeDest
            .To = ListeDest(i, 1)
            If BoxAttachments = vbYes Then
                .Attachments.Add sFichier
            End If
            .Subject = "Sujet test"
            .Body = "ceci est un test" & Chr(10) & Chr(13) & ListeService(i, 1) & Chr(10) & Chr(13) & ListeDistribution(i, 1) & "Bonne journée"
            
            BoxPreviewMsg = MsgBox("would you like to see the email before sending", vbQuestion + vbYesNoCancel + vbDefaultButton2, "Preview?")
            If BoxPreviewMsg = vbYes Then
                .Display
                BoxPreviewMsg = vbNo
                .Send
            ElseIf BoxPreviewMsg = vbCancel Then
                Exit Sub
            End If
        End With
        Set oMsg = Nothing
nextI:
    Next
    oMsgApp.Quit
    Set oMsgApp = Nothing
    MsgBox "Mail send"
End Sub
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Re

Par exemple, j'ai regrouper dans un seul module, ce qui est relatif à l'effacement
VB: 
Sub ClrIER()
fClear Worksheets("IER"), "V7:AJ254,AL7:AL254,AM7:BU254,BW7:CR254"
End Sub
Sub ZeroiseUserInfo_Ciquer()
fClear Worksheets("IER"), "M7:U254"
End Sub
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
Sinon suggestion
Pour les emails
Puisque que c'est la même procédure
Je la rendrai paramétrable pour n'avoir qu'une seule procédure.
Cliquez pour agrandir...
L effacement, c est une effacé simplement les noms des gens etc, et l autre efface le contenu du tableau ou l on encode ce que l on a besoin comme matériel. Maintenant, si on peut toujours avoir 2 boutons séparé. OK 😉

Pour les mails, c est l un fait pour la partie non classifié et l autre la classifié, est ce que ça joue quelque chose ? Comment le bouton fera la différence ?
 
Vote positif 0 Vote négatif
Et pour alléger le fichier, ce que je pensais faire c'est que la principal fonction c est index equiv et du concatener, comment combiner ça dans le vba. Si c est sur une cellule, je pense que c est pas trop compliqué, mais c est plutôt si ça se réfère à une cellule dans une colonne d un tableau structuré.

Comme dans mes messages précédents, on peut voir que le @ se rajoute dans ma formule, ce qui cause un erreur 😕 d ou le fait que je cherche à faire le travail dans le vba par bouton plutôt qu une formule, même si en soit ça marche, mais ralenti le fichier, vu que chaque formule dans le tableau attend impatiament d avoir quelques chose à faire
 
Vote positif 0 Vote négatif
Bonjour Staple,

Merci pour ce que tu fais 😉

voici dans les différents posts les résultats obtenus 🙂


Staple1600 à dit:
Re

Par exemple, j'ai regrouper dans un seul module, ce qui est relatif à l'effacement
VB: 
Sub ClrIER()
fClear Worksheets("IER"), "V7:AJ254,AL7:AL254,AM7:BU254,BW7:CR254"
End Sub
Sub ZeroiseUserInfo_Ciquer()
fClear Worksheets("IER"), "M7:U254"
End Sub
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
Sinon suggestion
Pour les emails
Puisque que c'est la même procédure
Je la rendrai paramétrable pour n'avoir qu'une seule procédure.
Cliquez pour agrandir...


Ca ca correspond a quoi? :/
VB: 
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600 à dit:
Re

Ce qui pourrait donner un truc dans ce genre
(je te laisse tester)
VB: 
Sub mails_CDN()
EnvoiMails
End Sub
Sub mails_MDN()
EnvoiMails "MDN"
End Sub

Sub EnvoiMails(Optional Destinataires As String = "CDN")
    Dim ListeDest() 'variable dans tableau USERS
    Dim ListeService() 'variable dans tableau USERS
    Dim ListeDistribution() 'variable dans tableau USERS
    Dim i&, oMsgApp As Outlook.Application, oMsg As Outlook.MailItem
    Dim sListeDest$, sFichier$, sFichierExist$, BoxAttachments%, BoxPreviewMsg%
    BoxAttachments = MsgBox("Do you want an attachment?", vbQuestion + vbYesNoCancel + vbDefaultButton2, "Attachments?")
    If BoxAttachments = vbYes Then
        sFichier = Application.GetOpenFilename(, , "Sélect your file for send")
        sFichierExist = Dir(sFichier)
            If sFichierExist = "" Then
                BoxAttachments = vbNo
            End If
    ElseIf BoxAttachments = vbCancel Then
        Exit Sub
    End If
Set oMsgApp = New Outlook.Application
Select Case Destinataires
    Case "CDN"
    ListeDest() = Range("USERS[CDN MAIL]") 'variable dans tableau USERS
    ListeService() = Range("USERS[SERVICE MAIL UNCLASS]") 'variable dans tableau USERS
    ListeDistribution() = Range("USERS[DISTRIBUTION LIST UNCLASS]") 'variable dans tableau USERS
    Case "MDN"
    ListeDest() = Range("USERS[MAILBOX]") 'variable dans tableau USERS
    ListeService() = Range("USERS[SERVICE MAIL CLASS]") 'variable dans tableau USERS
    ListeDistribution() = Range("USERS[DISTRIBUTION LIST CLASS]") 'variable dans tableau USERS
End Select
    For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
        If ListeDest(i, 1) = "" Then
           GoTo nextI
        End If
        Set oMsg = oMsgApp.CreateItem(olMailItem) 'create new mail
        With oMsg
            '.To = sListeDest
            .To = ListeDest(i, 1)
            If BoxAttachments = vbYes Then
                .Attachments.Add sFichier
            End If
            .Subject = "Sujet test"
            .Body = "ceci est un test" & Chr(10) & Chr(13) & ListeService(i, 1) & Chr(10) & Chr(13) & ListeDistribution(i, 1) & "Bonne journée"
           
            BoxPreviewMsg = MsgBox("would you like to see the email before sending", vbQuestion + vbYesNoCancel + vbDefaultButton2, "Preview?")
            If BoxPreviewMsg = vbYes Then
                .Display
                BoxPreviewMsg = vbNo
                .Send
            ElseIf BoxPreviewMsg = vbCancel Then
                Exit Sub
            End If
        End With
        Set oMsg = Nothing
nextI:
    Next
    oMsgApp.Quit
    Set oMsgApp = Nothing
    MsgBox "Mail send"
End Sub
Cliquez pour agrandir...

Renvois une erreur de liste global et si je fais annulé/fermé dans la fenêtre de pièce jointe parce que le client se serait trompé, alors il met aussi l'erreur :/
ListeDest() = Range("USERS[CDN MAIL]") 'variable dans tableau USERS

Mais c'est plus propre en soit 🙂
 
Vote positif 0 Vote négatif
Bonsoir le fil,

=>BullRot

Une feuille vierge dans un classeur lambda
Tu y copies le code VBA (dans un module standard)
Tu lances la macro avec le nom à rallonge
(mais néanmoins explicite 😉)
VB: 
Const Umma = 7
Const Gumma = 17
Sub Pour_Savoir_A_Quoi_Ca_Correspond(Optional C_pourtant_Evident_Non)
Cells(1).Resize(Umma, Gumma) = "=CHAR(RANDBETWEEN(65,90))"
MsgBox "Effacer les cellules A4:H6", vbOKOnly, "Test 1"
fClear ActiveSheet, "A4:H6"
MsgBox "Effacer la ligne 2", vbOKOnly, "Test 2"
fClear ActiveSheet, "2:2"
End Sub
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
Tu mobilises quelques neurones 😉
Et normalement, tu as la réponse à cette question 😉
Ca ca correspond a quoi? :/
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Bonsoir le fil,

=>BullRot

Une feuille vierge dans un classeur lambda
Tu y copies le code VBA (dans un module standard)
Tu lances la macro avec le nom à rallonge
(mais néanmoins explicite 😉)
VB: 
Const Umma = 7
Const Gumma = 17
Sub Pour_Savoir_A_Quoi_Ca_Correspond(Optional C_pourtant_Evident_Non)
Cells(1).Resize(Umma, Gumma) = "=CHAR(RANDBETWEEN(65,90))"
MsgBox "Effacer les cellules A4:H6", vbOKOnly, "Test 1"
fClear ActiveSheet, "A4:H6"
MsgBox "Effacer la ligne 2", vbOKOnly, "Test 2"
fClear ActiveSheet, "2:2"
End Sub
Private Function fClear(F As Worksheet, Plage_ADR$)
F.Range(Plage_ADR).ClearContents
End Function
Tu mobilises quelques neurones 😉
Et normalement, tu as la réponse à cette question 😉
Cliquez pour agrandir...

😀

FJYMECJZOPTROEOAW
VPPVQCSPKHFDNACEU
SSGQWHPCL
RNTKPGEPD
WDJTUQOPX
UKZXIFHCLWTUCWHLG

Si j'etais en 40/45 je dirais que j'ai trouvé le code d'ENIGMA 😱 😀
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

oguruma
EXCEL :: VBA :: Activer - Désactiver les filtres dans un tableau en plage d'adresses ou dans un tableau structuré
Réponses
0
Affichages
450
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
914
oguruma
oguruma
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
P
  • Question Question
Microsoft 365 Comparaison de tableaux !
Réponses
1
Affichages
2 K
Patrosso
P
Retour