Programmation sur Excel?Résolu

Question

Bonjour,

Je dois pour mon boulot transformer plus de 10 ans de relevés de compte dans excel.

Mon problème après scannage de ceux ci, c'est que lorsqu'il y a plusieurs payements le même jour,
j'ai  dans une même cellule texte descriptif des dépenses et sommes de ceux-ci dans la même cellule.
Mon idée, afin d'éviter de devoir moi même les déplacer dans une colonne à côté et rajouter des lignes s'il le faut, c'est  de rechercher partout dans le texte de ces cellules, le string "CHF", noté tjs avant le nombre. Puis couper le descriptif et nombre.

Je ne sais cependant pas comment programmer un macro sous excel, quelqu'un pourrait-il m'aider, cela me ferais gagner plus de 3 semaines de travail, long et risqué dans l'erreur de la recopie des nombres.

Je vous remercie d'avance de votre future aide.

L.Oswald

melonmaudic · Accepted Answer

Alors voici le code qui fonctionne, on ne sait jamais ça peut peut-être servir à qqn d'autres:

Sub SepareSomme()

derniereligne = 2000

j = 6 'selection de colone

For i = 2 To derniereligne

    'nb indique l'endroit du CHF
    
    nb = InStr(1, Cells(i, j), "CHF", 0)
    Do While nb > 0
    nb = InStr(1, Cells(i, j), "CHF", 0)
     If nb > 0 Then
        nba = nb + 4 'correction pour avoir la somme
        
        test = InStr(nba, Cells(i, j), Chr(10), 0)
        
        'Trouve la somme
        If test > 1 Then
        fin = Application.WorksheetFunction.Search(Chr(10), Cells(i, j), nba)
        fina = fin - nba 'nombre de caractere dans cette somme
        
        somme = Mid(Cells(i, j), nba, fina)
        info = Mid(Cells(i, j), 1, nb - 1)
        reste = Mid(Cells(i, j), fin)
         
        Rows(i + 1).Insert Shift:=xlDown
        t = j - 1
        Cells(i, t) = somme
         
         m = i
         m = m + 1
         Cells(m, j) = reste
         Cells(i, j) = info
         derniereligne = derniereligne + 1
        Else
        somme = Mid(Cells(i, j), nba)
        info = Mid(Cells(i, j), 1, nb - 1)
        t = j - 1
        Cells(i, t) = somme
         Cells(i, j) = info
         derniereligne = derniereligne + 1
        End If
         
        
       
         
       
    

    End If
   Loop

Next

End Sub

L.Oswald

FMatrix07 · Answer

Salut
Ce qui serait bien c'est que tu mets un exemple de ta ligne pour voir les séparateurs:
tu peux utiliser
PositionChif = InStr(1, cellule, "CHF", 0) pour avoir la position de ton CHF devant le premier nombre

melonmaudic · Answer

Oui  pardon je n'y avais pas penser.
------------------------------------------------------
Alors voici un exemple:

BALANCE CLOSING ENTRIES
DETAILS OF CLOSING ENTRY           
01.01.2002 - 31.03.2002            
DEBIT INTEREST   3.75              CHF 704.75-
FROM 01.01.2002                    
DEBIT INTEREST   3.5               CHF 825.10-
FROM 01.02.2002                    
DEBIT INTEREST   3.75              CHF 864.65-
FROM 01.03.2002                    
CREDIT COMM. A/AVE.DEBIT           
   0.25   ON  261701.42            CHF 654.25-
SERVICE CHARGES                    CHF 8.50-
POSTAL CHARGES                     CHF 28.80-
ACCOUNT KEEPING                    CHF 6.00-

------------------------------------------------------

L'idéal serait d'afficher les sommes dans une colonne en parallèle et que cette cellule soit fractionnée en 7 nouvelles lignes, afin de pouvoir additionner ces sommes. Que chaque somme soit dans une colonne à côté et séparer par une ligne.

Merci de ton aide.

L.Oswald

melonmaudic · Answer

P.s. ma cellule en question se trouve en E et j'aimerais mettre mes nombres en D.
Merci beaucoup de ton aide.

L.Oswald

melonmaudic · Answer

Si jamais, j'ai fait ce code, mais ca ne fonctionne tjs pas:

Sub SepareSomme()

derniereligne = [A1].End(xlDown).Row

For i = 2 To derniereligne

    Dim nb As Integer 'indique l'endroit du CHF
    
    nb = InStr(1, Cells(i, 6), "CHF", 0)
     If nb > 0 Then
        nba = nb + 4 'correction pour avoir la somme
        Dim fin As Integer

        'Trouve la somme
        fin = Application.WorksheetFunction.Search(" ", Cells(i, 6), nba)
        fin = fin - nba 'nombre de caractere dans cette somme
      
        somme = Mid(Cells(i, 6), nba, fin)
        info = Mid(Cells(i, 6), 0, nb)
        reste = Mid(Cells(i, 6), fin, Cells(i, 6).Length)
        
        'Replace le signe negatif, s'il le faut
        nbb = InStr(1, somme, "-", 0)
            If nbb > 1 Then
                nbb = nbb - 1
                somme = "-" + Mid(somme, 1, nbb)
               
            End If
            'inscription dans cellule
         Cells(i, 5) = somme
         Cells(i, 6) = info
         Rows(i).Insert Shift:=xlDown
         m = i
         m = m + 1
         Cells(m, 6) = reste
         derniereligne = [A1].End(xlDown).Row
    

    End If
Next

End Sub

L.Oswald

Programmation sur Excel?

5 réponses

Votre réponse

Discussions similaires