Discussion :

[jeremy75018]

Bonjour tout le monde,

dans la colonne A : j'ai des valeurs de type : de C à C00000001000001 ( donc de 1 caractère à x)
Dans la colonne B: je copie ces valeurs

Je souhaiterai en VBA

Dans la colonne B garder les 10 premiers caractères si le nombre de caractères est supérieur ou égal à 10.

je souhaiterai l'appliquer à toute la colonne B

En vous remerciant d'avance

[XLRATOR]

Bonsoir,
Un code pour ce faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim rng As Range
For Each rng In Columns(2).SpecialCells(xlCellTypeConstants).Cells
If Len(rng) >= 10 Then
rng.Value = Left(rng, 10)
End If
Next

Cordialement.
Karim

[jeremy75018]

Mon fichier étant assez lourd (plus de 100 000 lignes et 20 Colonnes)

J'ai copié le code proposé puis exécuté mais malheureusement mon fichier ne répond plus (20 min "ne répond plus")

Pouvez-vous y jeter un oeil?

ci dessous le code complet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
Dim rng As Range
Dim Nc, Cel As Range, LigFin As Variant, I As Variant
 
    Sub ZPMQ()
 
 
    Application.ScreenUpdating = False
    Sheets("ZPMQ").Select
    LigFin = Sheets("ZPMQ").Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B" & LigFin).ClearContents
    Range("A2:A" & LigFin).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    ActiveSheet.Paste
 
    For Each rng In Columns(2).SpecialCells(xlCellTypeConstants).Cells
    If Len(rng) >= 10 Then
    rng.Value = Left(rng, 10)
    End If
    Next
    Application.ScreenUpdating = True
 
    End Sub

Encore Merci

[XLRATOR]

Votre code quelque peu amélioré:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub ZPMQ()
Application.ScreenUpdating = False
 
        LigFin = Sheets("ZPMQ").Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("ZPMQ").Range("B2:B" & LigFin).FillRight
 
        For Each rng In Columns(2).SpecialCells(xlCellTypeConstants).Cells
        If Len(rng) >= 10 Then
        rng.Value = Left(rng, 10)
        End If
        Next
End Sub

Bon courage.
Karim.

[jeremy75018]

Merci Karim,

Mon fichier est toujours en mode ne répond plus...

[XLRATOR]

Vous savez? il n'y a rien de volumineux qui s'exécute dans ce code, le problème serait alors lié à un long calcul ou une autre macro qui se déclenche en conséquence des changements qui ressortent de l'exécution de cette macro.
Cordialement.
Karim.