traduction algo en vba ?

dgino

XLDnaute Nouveau
Quelqu'un pourrait-il m'aider à traduire en vba un algorithme que j'ai écrit en langage naturel s'il vous plait ?
Si ce n'est pas trop compliqué bien sur, je ne me rends pas trop compte car je m'y connais très peu en vba.
je pense exécuter cet algorithme à l'ouverture d'excel mais si il y a mieux à faire, dîtes-moi.
Le voici :

soit nom-feuille une variable de type feuille
nom-feuille = 1

soit num-cellule une variable de type cellule

soir nom-classeur une variable de type classeur

tant que nom-feuille inférieur à 47
faire

nom-classeur = la variable nom-feuille suivi de -PPI.xlsx (par exemple 1-PPI.xlsx)

pour num-cellule de A1 à D20, sauf les cellules vides
(c'est à dire A1, A2...A20, pui B1, B2...B20 etc. jusqu'à D20 sauf les cellules vides)
faire

la valeur de la cellule num-cellule de la feuille nom-feuille
= la valeur de la cellule num-cellule de la feuille A
du classeur nom-classeur dont le chemin d'accès est C:\

fin de la bouche pour

nom-feuille = nom-feuille+1
fin de la boucle tant que
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Bonjour dgino,

Le classeur de destination doit accepter les macros : enregistrez-le en .xlsm (ou .xls).

Alors collez dans son ThisWorkbook :

Code:
Private Sub Workbook_Open()
Dim w As Worksheet, nf As Long, F As String
Application.DisplayAlerts = False 'si un fichier n'existe pas
For Each w In Worksheets
  nf = Val(w.Name)
  If nf > 0 And nf < 47 Then
    F = "=IF('C:\[" & nf & "-PPI.xlsx]A'!RC="""","""",'C:\[" & nf & "-PPI.xlsx]A'!RC)"
    w.[A1:D20].FormulaR1C1 = F
    w.[A1:D20] = w.[A1:D20].Value 'facultatif, pour ne garder que les valeurs
  End If
Next
End Sub
Bien noter que dans les classeurs sources la feuille source se nomme "A", sinon adapter la formule F.

A+
 

dgino

XLDnaute Nouveau
Re : traduction algo en vba ?

je vais essayer de retraduire ton code en langage naturel :

soit w une feuille, nf un nombre et F une chaîne de caractère.
désactiver les alertes d'excel si un fichier appelé n'existe pas.
pour chaque feuilles du classeur :
//pourquoi pour chaque feuille ? il y a que les feuilles numérotées de 1 à 47 qui sont concernées, on ne pourrait pas faire un test qui évite de prendre les feuilles dont le nombre > 47 ou dont le nom est une chaîne de caractère ?
nf reçoit la valeur du nom de la feuille
//quid d'une feuille qui n'est pas un nombre mais une chaîne de caractère ?
(1er si) si nf > 0 et <= à 47, alors faire :
(2eme si) si RC de la feuille A du classeur dont le nom est nf-PPI.xlsx et dont le chemin d'accès est C:\, est/ (ou sont) vide : ne rien faire
//que veux-dire RC svp ? une sorte de boucle pour ?
sinon faire :
F= RC de la feuille A du classeur dont le nom est nf-PPI.xlsx et dont le chemin d'accès est C:\
fin du 2eme si
les cellules de A1 à D20 de la feuille w recoivent la valeur de F
fin du 1er si
fin de la boucle pour
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Re,

Je n'expliquerai pas plus le code du post #2 car il est vraiment simple à comprendre.

Simplement il faut savoir comment fonctionne la fonction Val.

L'aide VBA est faite pour ça :rolleyes:

Et pour comprendre (et voir dans les feuilles) la formule F mettre en commentaire l'instruction :

Code:
w.[A1:D20] = w.[A1:D20].Value
A+
 

dgino

XLDnaute Nouveau
Re : traduction algo en vba ?

Je commence à pas mal comprendre le code qui m'a été donné mais j'ai encore quelques difficultés :
A présent, je voudrais modifier ce code pour qu' en parcourant de A1 à D20, dès qu'une cellule vide est trouvée, la recopie s’arrête.
Par exemple pour les cellules à copier : A1=1, A2=2 A3="" (vide), A4=1,... B2="" (vide),...D20=1 etc.
ça recopiera uniquement les cellules A1 et A2, et non A4, ni les suivantes.
je n'arrive pas à comprendre comment je peux coder ça.
Si vous aviez la gentillesse de me montrer comment je peux faire s'il vous plait...
 

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Bonjour dgino, le forum,

Ce nouveau problème n'est pas très clair :

- la plage A1: D20 des feuilles de destination doit-elle être préalablement vidée ?

- quand la cellule à copier est vide, on arrête toute copie ou l'on passe à la colonne suivante ?

En supposant qu'on vide la plage et qu'on arrête toute copie :

Code:
Private Sub Workbook_Open()
Dim w As Worksheet, nf&, j As Byte, i As Byte, F$, test$
Application.DisplayAlerts = False 'si un fichier n'existe pas
For Each w In Worksheets
  nf = Val(w.Name)
  If nf > 0 And nf < 47 Then
    w.[A1:D20].ClearContents 'est-ce nécessaire ???
    For j = 1 To 4 'colonnes A à D
      For i = 1 To 20
        F = "'C:\[" & nf & "-PPI.xlsx]A'!R" & i & "C" & j
        test = F & "<>"""""
        If ExecuteExcel4Macro(test) Then _
          w.Cells(i, j).FormulaR1C1 = "=" & F Else GoTo 1
      Next
    Next
1   w.[A1:D20] = w.[A1:D20].Value 'pour ne garder que les valeurs
  End If
Next
End Sub
A+
 

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Re,

Avec les mêmes hypothèses, on peut aussi utiliser plus simplement :

Code:
Private Sub Workbook_Open()
Dim w As Worksheet, nf&, j As Byte, i As Byte, F$, test$
Application.DisplayAlerts = False 'si un fichier n'existe pas
For Each w In Worksheets
  nf = Val(w.Name)
  If nf > 0 And nf < 47 Then
    w.[A1:D20].ClearContents 'est-ce nécessaire ???
    For j = 1 To 4 'colonnes A à D
      For i = 1 To 20
        F = "'C:\[" & nf & "-PPI.xlsx]A'!R" & i & "C" & j
        test = F & "<>"""""
        If ExecuteExcel4Macro(test) Then _
          w.Cells(i, j) = ExecuteExcel4Macro(F) Else GoTo 1
      Next
    Next
  End If
1 Next
End Sub
A+
 

dgino

XLDnaute Nouveau
Re : traduction algo en vba ?

Quelques précisions donc :
- la plage A1: D20 des feuilles de destination doit-elle être préalablement vidée ?
J'imagine qu'au départ si les cellules sont vides ça remplit, si elle ne le sont pas ça écrase l'ancienne valeur, tout simplement. Quel est l'interêt qu'elles soient toutes vides avant la recopie ?
- Quand la cellule à copier est vide, on arrête toute copie ou l'on passe à la colonne suivante ?
On arrête toute copie, c'était implicite pour moi

Je vais essayé ton code et je te dis si ça marche bien.
Ah ça ne marche pas, ça me met "erreur d'execution '13' - incompatibilité de type", ensuite ça me souligne ça en jaune dans le code :
Code:
If ExecuteExcel4Macro(test) Then
Et si j'enlève cette condition, ça exécute donc ce code tout le temps :
w.Cells(i, j) = ExecuteExcel4Macro(F) si j'ai bien compris
L’exécution fonctionne mais ça me met des #REF! partout dans les cellules visées
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Bonsoir,

Sachez que quand je dépose un code il a été testé : chez moi les 2 dernières macros fonctionnent bien.

A un détail près : il y aura bug en effet si le fichier source ou la feuille "A" n'existent pas, ou encore si la plage copiée contient des valeurs d'erreur.

Le plus simple est alors d'utiliser On Error Resume Next :

Code:
Private Sub Workbook_Open()
Dim w As Worksheet, nf&, j As Byte, i As Byte, F$, test$
Application.DisplayAlerts = False
On Error Resume Next
For Each w In Worksheets
  nf = Val(w.Name)
  If nf > 0 And nf < 47 Then
    w.[A1:D20].ClearContents 'est-ce nécessaire ???
    For j = 1 To 4 'colonnes A à D
      For i = 1 To 20
        F = "'C:\[" & nf & "-PPI.xlsx]A'!R" & i & "C" & j
        test = F & "<>"""""
        If ExecuteExcel4Macro(test) Then _
          w.Cells(i, j) = ExecuteExcel4Macro(F) Else GoTo 1
      Next
    Next
  End If
1 Next
End Sub
Je ne peux rien faire de plus pour vous, vérifiez vos fichiers sources.

Quant à ceci :

J'imagine qu'au départ si les cellules sont vides ça remplit, si elle ne le sont pas ça écrase l'ancienne valeur, tout simplement. Quel est l'interêt qu'elles soient toutes vides avant la recopie ?

Réfléchissez un peu... Les anciennes valeurs ne sont pas toutes écrasées si la copie s'arrête (cellule vide).

A+
 

job75

XLDnaute Barbatruc
Re : traduction algo en vba ?

Re,

Avant d'aller faire dodo.

Mes macros des posts #10 #11 et #13 sont beaucoup trop lentes sur 46 feuilles.

Cette macro, dérivée de celle du post #2, est très rapide et bien plus simple :

Code:
Private Sub Workbook_Open()
Dim w As Worksheet, nf&, F$, flag As Boolean, j As Byte, i As Byte
Application.DisplayAlerts = False 'si un fichier n'existe pas
For Each w In Worksheets
  nf = Val(w.Name)
  If nf > 0 And nf < 47 Then
    F = "=IF('C:\[" & nf & "-PPI.xlsx]A'!RC="""","""",'C:\[" & nf & "-PPI.xlsx]A'!RC)"
    w.[A1:D20].FormulaR1C1 = F
    w.[A1:D20] = w.[A1:D20].Value 'pour ne garder que les valeurs
    flag = False
    For j = 1 To 4 'colonnes A à D
      For i = 1 To 20
        If IsEmpty(w.Cells(i, j)) Then flag = True
        If flag Then w.Cells(i, j) = ""
      Next
    Next
  End If
Next
End Sub
Bonne nuit et A+
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 333
Membres
103 519
dernier inscrit
Thomas_grc11