Distribuer montants d'une colonne aux colonnes correspondantes d'un tableau
Bonjour à tous,
J'aimerais que vous me aidiez avec un problème que je ne suis pas capable de résoudre de manière pratique.
Dans un tableau, j'ai des montants dans un colonne et à la droite de cette colonne il y a des colonnes où apparaissent des "x" pour signaler à quelle colonne appartient le montant de chaque ligne.
Pour s'adapter a notre nouveau fournisseur, je dois copier la valeur du montant à la place de chaque "x".
J'en ai une soixantaine de fichiers à faire, variant entre 10 et 60 lignes.
Mon risque d'erreur est trop grand et mon échéancier trop court
J'ai vraiment besoin d'aide
Merci d'avance
bonjour,
une solution basée sur une macro. à mettre dans un nouveau module.
Sub aargh()
With ActiveSheet
maxj = 50 '50 colonnes maximum
dl = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 9 To dl
For j = 4 To maxj
If .Cells(i, j) = "x" Then
.Cells(i, j) = .Cells(i, 3)
Exit For
End If
Next j
Next i
End With
End Sub
on peut également automatiser l'exécution sur tous les fichiers à adapter. Dans ce cas, j'ai besoin d'info supplémentaire.
tous les fichiers et uniquement ceux-là sont-ils dans le même répertoire ? sont-ils dans un même répertoire mais avec des fichiers qu'il ne faut pas convertir ? dans ce cas, comment peut-on déterminer les fichiers à convertir ?
[Bonjour h2so4,
D'abord pour ta réponse si rapide. J'ai essayé la macro en définissant les variables et elle marche très bien ( je suis vraiment très rouillé en VBA).
En ce qui concerne tes questions:
1. Je peux m'arranger pour mettre tous les fichiers à changer dans un même répertoire. En fait trois répertoires différents avec des fichiers semblables à l'exemple, mais de différents personnes.
2. Je ne suis pas sur si tous les fichiers de chaque répertoire commencent à la ligne 9. Si je change le i=9 pour un répertoire, je crois pas de causer problème n'est pas?
Si tu est capable de m'aider à faire les modification de manière automatique dans chacun de trois répertoires, il serai vraiment l'idéal.
Dernière chose, comme on fait pour conserver le format et les deux chiffres décimales lors de la copié?
Merci d'avance
Ci joint le fichier que je viens de travailler
bonsoir,
code adapté pour convertir tous les fichiers (leur première feuille) présents dans une liste de répertoire, la première ligne qui sera prise en compte est une ligne qui contient une date en colonne A dans les 50 premières lignes
Option Explicit
Sub montants()
Dim maxj As Long
Dim dl As Long
Dim i As Long
Dim j As Long
Dim listerepertoire As Variant, chemin As String, f As String, wb As Object, r As Long, k As Long
listerepertoire = array("d:\downloads\test","d:\downloads\test\test") ' à adapter
For r = LBound(listerepertoire) To UBound(listerepertoire) 'on parcourt la liste des répertoires
chemin = listerepertoire(r)
f = Dir(chemin & "\*.xls*")
Do While f <> "" 'on parcourt la liste des fichiers du répertoires
Set wb = Workbooks.Open(chemin & "\" & f) 'ouverture du classeur
With wb.Sheets(1) 'on travaille avec la première feuille du classeur
maxj = 50 '50 colonnes maximum + 50 lignes maximum avant de trouver une date en colonne A
dl = .Cells(Rows.Count, 1).End(xlUp).Row
k = 1
Do Until IsDate(.Cells(k, 1)) 'recherche de la première ligne -> k
k = k + 1
If k > maxj Then Exit Do ' trop de lignes examinées on ignore ce classeur
Loop
If k < maxj Then
For i = k To dl 'de la ligne k à la dernière ligne utile du classeur
For j = 4 To maxj 'de la colonne 4 à la colonne maxj maximum
If .Cells(i, j) = "x" Then 'si on a trouvé un x
.Cells(i, j) = .Cells(i, 3) 'on transfère le montant
.Cells(i, j).NumberFormat = "#,###.00" 'on met la cellule au bon format
Exit For
End If
Next j
Next i
End If
End With
Application.DisplayAlerts = False
wb.Save 'on save le classeur
wb.Close True 'on ferme le classeur
Application.DisplayAlerts = True
f = Dir() 'on prend le classeur suivant dans le répertoire
Loop
Next r 'répertoire suivant
End Sub
Bon soir h2so4,
Merci encore pour ta réponse. Demain aussi tôt que j’aille accès aux données dans l’ordinateur de mon fils, j’essaierai ta solution.
J’ai vais créer un répertoire neuf avec 3 sous-répertoires.
Je vais créer un nouveau fichier Excel avec le module que tu as conçu et je ferai fonctionner la macro.
Question:
Est-ce que il faut que les sous-dossiers soient imbriqués un à l’intérieur de l’autre, ou je peut utiliser 3 sous-répertoires séparés à l’intérieur d’un répertoire principal?
Encore merci de ton aide, c’est très apprécié
bonjour,
Est-ce que il faut que les sous-dossiers soient imbriqués un à l’intérieur de l’autre, ou je peut utiliser 3 sous-répertoires séparés à l’intérieur d’un répertoire principal?
les sous-répertoires ne doivent pas nécessairement être imbriqués.
Bonjour h2so4,
Ta macro fonctionne numéro 1 !
par contre le fournisseur exige que les montants des dépenses doivent apparaître comme positifs et ceux d'intrants comme négatives, ce qui veux dire qu'il faudrait changer les montants de la colonne "C" de positifs à négatifs et les négatifs à positifs avant de faire le remplacements des "x" par les montants.
Est ce qu'il y a un moyen d'ajouter cette condition dans ta macro?
Encore merci de ton aide
bonsoir,
remplace cette instruction
.Cells(i, j) = .Cells(i, 3) 'on transfère le montant
par celle-ci
.Cells(i, j) = - .Cells(i, 3) 'on transfère le montant en changeant de signe
Bonjour h2so4,
J'ai fait le changement, mais malheureusement il n'y a pas d'impact sur les fichiers
Je n'ai comprend pas, mais l'ajout du signe "-" ne change le signe lors des remplacements.
Merci de la réponse si vite quand même
Sub montants_signe() 'remplace les "x" est change le signes de montants
Dim maxj As Long
Dim dl As Long
Dim i As Long
Dim j As Long
Dim listerepertoire As Variant, chemin As String, f As String, wb As Object, r As Long, k As Long
listerepertoire = Array("c:\users\Jose\Documents\test BK\JAG c", "c:\users\Jose\Documents\test BK\JAG g", "c:\users\Jose\Documents\test BK\JAG m") ' à adapter
For r = LBound(listerepertoire) To UBound(listerepertoire) 'on parcourt la liste des répertoires
chemin = listerepertoire(r)
f = Dir(chemin & "\*.xls*")
Do While f <> "" 'on parcourt la liste des fichiers du répertoires
Set wb = Workbooks.Open(chemin & "\" & f) 'ouverture du classeur
With wb.Sheets(1) 'on travaille avec la première feuille du classeur
maxj = 50 '50 colonnes maximum + 50 lignes maximum avant de trouver une date en colonne A
dl = .Cells(Rows.Count, 1).End(xlUp).Row
k = 1
Do Until IsDate(.Cells(k, 1)) 'recherche de la première ligne -> k
k = k + 1
If k > maxj Then Exit Do ' trop de lignes examinées on ignore ce classeur
Loop
If k < maxj Then
For i = k To dl 'de la ligne k à la dernière ligne utile du classeur
For j = 4 To maxj 'de la colonne 4 à la colonne maxj maximum
If .Cells(i, j) = "x" Then 'si on a trouvé un x
.Cells(i, j) = -.Cells(i, 3) 'on transfère le montant en changeant de signe
.Cells(i, j).NumberFormat = "# ###.00" 'on met la cellule au bon format
Exit For
End If
Next j
Next i
End If
End With
Application.DisplayAlerts = False
wb.Save 'on save le classeur
wb.Close True 'on ferme le classeur
Application.DisplayAlerts = True
f = Dir() 'on prend le classeur suivant dans le répertoire
Loop
Next r 'répertoire suivant
End Sub
Bonjour h2so4,
J'ai réussi à changer les signes des montants qui remplaçaient les "x" en changeant
la ligne
.Cells(i, j) = - .Cells(i, 3) 'on transfère le montant en changeant de signe
pour
.Cells(i, j) = -1 * .Cells(i, 3) 'on transfère le montant en changeant de signe
Avec ça la macro est complète et nickel.
Merci beaucoup de ton aide, Très appréciée
Explorador