Décalage d'une partie de texte dans une cellule en VBA

Le 29/12/2021 à 23:57

Bonjour à tous,

Je cherche à séparer une partie de caractère texte dans la même cellule pour que l'on puisse visualiser plus facilement les derniers chiffres, mais seulement dans la cellule.

Avec la fonction convertir, je ne peux pas. Pouvez vous m'aider svp avec une macro que je pourrai intégrer dans une autre?

Ce que je voudrais en pièce jointe est d'insérer 5 espaces après "TF" et ce pour chaque ligne ( il y en a 3000 des fois )

Merci d'avance pour votre aide toujours bienveillante.

11decalage-texte.xlsm (39.45 Ko)

Cdt Laurent

Le 30/12/2021 à 00:10

Bonjour,

en formule en C4 : =STXT(B4;1;NBCAR(B4)-7)&" "&DROITE(B4;7)

Attention ! ici j'ai indiqué 7 alors que le nombre est sur 6 digits, mais vous avez un espace en fin de donnée...

@ bientôt

LouReeD

Le 30/12/2021 à 01:04

Bonjour,
Une proposition VBA ?
Cdlt.

19decalage-texte.xlsm (33.17 Ko)

Public Sub ModifyTexts()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim tbl As Variant

    Set ws = ThisWorkbook.Worksheets("RMC")

    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(4, 2).Resize(lastRow - 3).Value
        For i = LBound(tbl) To UBound(tbl)
            If VBA.InStr(tbl(i, 1), "TF") > 0 Then
                tbl(i, 1) = WorksheetFunction.Substitute(tbl(i, 1), "TF", "TF     ")
            End If
        Next i
        .Cells(4, 6).Resize(lastRow - 3).Value = tbl
        '.Cells(4, 2).Resize(lastRow - 3).Value = tbl pour remplacer en lieu et place.
    End With

End Sub

Le 30/12/2021 à 13:14

Bonjour àtous,

Jean-Eric et LouReeD , je vous remercie pour cette aide. Je garde la fonction =stxt pour la fonction dans les archives et

ai intégré celle en VBA dans ma macro final pour mon sujet qui va me faire gagner beaucoup de temps dans mon travail.

Jean-Eric, j'ai remplacé la ligne qui décale sur une autre colonne par celle que vous m'avez pré-notifié.

C'est super, ca fonctionne bien.

Next i
'.Cells(4, 6).Resize(lastRow - 3).Value = tbl
.Cells(4, 2).Resize(lastRow - 3).Value = tbl

L'avantage sur ce site est que l'on a toujours une aide bienveillante surtout quand on ne comprend pas tout comme moi

Merci encore et je vous souhaite tous de passer un bon réveillon

Laurent

Le 30/12/2021 à 18:42

Bonsoir,

merci pour votre retour et vos remerciements et je vous souhaite également un bon réveillon de la St Sylvestre !

@ bientôt

LouReeD

Le 02/01/2022 à 22:48

9decalage.xlsm (34.09 Ko)

Bonjour Jean-Eric

J'ai un soucis avec mon bout de macro que vous m'avez donnée et qui fonctionne bien quand je la créé dans un classeur normal. ( celle en PJ). Je voudrais insérer cette macro dans mon classeur PERSONAL.xlsB mais j'ai une erreur systématique ci dessous en photo.

Par contre, je ne l'ai pas quand la macro est intégrée au classeur normal.

==> Pour rappel j'ai BIN_ALLIANCE 295105928RTF186326 affiché et le décalage une fois la macro lancée = BIN_ALLIANCE 295105928RTF 186326.

Je vous mets en PJ votre macro qui fonctionne.

Et les photos dans les macro PersonnalXLSB.

En fait, une fois créée, il y a deux modules qui s'affichent au lieu de la macro créée au lieu de PERSONAL.XLSB!décal_bin.

Merci d'avance pour m'expliquerce qui ne va pas.

Laurent

r 2

Le 02/01/2022 à 22:59

Bonsoir,

essayez de mettre ActiveWorkBook à la place de ThisWorkBook, en effet une macro qui est écrite dans un classeur B par exemple, s'il y a ThisWorkBook alors c'est B qui sera ciblé. Enfin je pense... Jean-Eric ?

Je ne suis pas très fort sur les multi classeurs !

@ bientôt

LouReeD

Le 03/01/2022 à 09:19

Bonjour,
Essaie ainsi :

Public Sub ModifyTextsSheetRMC()
Dim wb As Workbook, ws As Worksheet
Dim lastRow As Long, i As Long
Dim tbl As Variant

    On Error GoTo errHandler

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("RMC")

    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(4, 2).Resize(lastRow - 3).Value
        For i = LBound(tbl) To UBound(tbl)
            If VBA.InStr(tbl(i, 1), "TF") > 0 Then
                tbl(i, 1) = WorksheetFunction.Substitute(tbl(i, 1), "TF", "TF     ")
            End If
        Next i
        .Cells(4, 2).Resize(lastRow - 3).Value = tbl
    End With

exitHandler:
    Set ws = Nothing: Set wb = Nothing
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & vbNewLine & Err.Description
    Resume exitHandler

End Sub

Le 03/01/2022 à 14:32

Hello,

Cela fonctionne dans PERSONAL.XLSB à condition que j'ai deux macros séparées.

La première qui me fait l'extract et la mise en forme. ==>je te l'ai mise ci dessous

et La deuxième que tu m'as donnée

==>Mais quand je veux ajouter ta macro dans la première, il y a une erreur dans PERSONAL.XLSB

MErci pour m'aider à n'avoir qu'une seule macro dans PERSONAL.XLSB.MAis en me mettant deux raccourcis pour ls 2 macros dans mes macros personnelles, cela marche

La première est celle ci

Sub ext_bin_bt4()
Dim i As Long, c As Range, rep As String, adresse1 As String
If Range("B3") = "BIN_ALLIANCE" Then Exit Sub
If Range("B3") <> "BIN_ALLIANCE" Then
Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Value = "BIN_ALLIANCE"
Else
Range("B4:B3000").ClearContents
End If
rep = InputBox("Mot à rechercher", "BIN_ALLIANCE") 'recherche du mot laurent dans l'exemple
If rep = "" Then Exit Sub
'Match

Set c = Sheets(1).Cells.Find("*" & rep & "*", LookIn:=xlValues)
If Not c Is Nothing Then
adresse1 = c.Address
Do
Range("B" & c.Row).Value = c.Value
Set c = Sheets(1).Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> adresse1
End If

'Copier coller de colonne VF1
Columns("D:D").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight

'Copier coller de colonne Enchainement
Columns("U:U").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight

'Copier coller de colonne localisation
Columns("T:T").Select
Selection.Copy
Columns("D:D").Select
Selection.Insert Shift:=xlToRight

'Copier coller de VF1 pour la cacher plus loin
Columns("G:G").Select
Selection.Copy
Columns("X:X").Select
Selection.Insert Shift:=xlToRight

' Mise en forme Macro

ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 15.8
Range("B9").Select
Columns("B:B").ColumnWidth = 30.5
Columns("B:B").ColumnWidth = 35.3
Columns("B:B").ColumnWidth = 39.4
Columns("C:C").ColumnWidth = 10.6
Columns("C:C").ColumnWidth = 9.2
Columns("D:D").ColumnWidth = 6.5
Range("A1:E1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1:E3062").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$GF$1678").AutoFilter Field:=2, Criteria1:="<>"

'MEF finale avec tri colonne enchainement
Columns("E:E").ColumnWidth = 20.4
Columns("E:E").ColumnWidth = 22.1
Columns("F:F").ColumnWidth = 35.7
Range("A3:E3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("C4:C3012").Select
ActiveWindow.ScrollRow = 2988
ActiveWindow.ScrollRow = 2983
ActiveWindow.ScrollRow = 2978
ActiveWindow.ScrollRow = 2948
ActiveWindow.ScrollRow = 2804
ActiveWindow.ScrollRow = 2729
ActiveWindow.ScrollRow = 2024
ActiveWindow.ScrollRow = 1780
ActiveWindow.ScrollRow = 1129
ActiveWindow.ScrollRow = 945
ActiveWindow.ScrollRow = 473
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 1
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add2 Key:=Range( _
"C1:C3012"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:GF3012")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$GF$1680").AutoFilter Field:=3, Criteria1:="<>"
Range("B1368").Select
End Sub

Et la deuxième est ta dernière macro

Public Sub decalage()
Dim wb As Workbook, ws As Worksheet
Dim lastRow As Long, i As Long
Dim tbl As Variant

On Error GoTo errHandler

Set wb = ActiveWorkbook
Set ws = wb.Worksheets(1)

With ws
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
tbl = .Cells(4, 2).Resize(lastRow - 3).Value
For i = LBound(tbl) To UBound(tbl)
If VBA.InStr(tbl(i, 1), "TF") > 0 Then
tbl(i, 1) = WorksheetFunction.Substitute(tbl(i, 1), "TF", "TF ")
End If
Next i
.Cells(4, 2).Resize(lastRow - 3).Value = tbl
End With

exitHandler:
Set ws = Nothing: Set wb = Nothing
Exit Sub
errHandler:
MsgBox "Erreur : " & Err.Number & vbNewLine & Err.Description
Resume exitHandler

End Sub

Le 03/01/2022 à 19:38

11rmc.zip (10.33 Ko)

Bonsoir Jean Eric et Loureed, décidemment, VBA est hard pour ls néophytes.

Du coup, l'erreur en intégrant les deux macros était qu'il y avait deux fois "i as long". J'ai donc remplacer en mettant "m as long " dans la deuxième macro à partir de la ligne surlignée en jaune ci dessous dans ma macro final.

Par contre, maintenant j'ai un décalage après "TF" de 1 seul caractère alors qu'il y en vait 5 avec la macro de base. Est ce à cause du "m as long"

au lieu de "i as long" ?

Merci d'avance. Voici ma macro finale et le fichier que je reçois avant de l'extraire en PJ

Sub ext_bin_bt4()

Dim i As Long, c As Range, rep As String, adresse1 As String
If Range("B3") = "BIN_ALLIANCE" Then Exit Sub
If Range("B3") <> "BIN_ALLIANCE" Then
Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Value = "BIN_ALLIANCE"
Else
Range("B4:B3000").ClearContents
End If
rep = InputBox("Mot à rechercher", "BIN_ALLIANCE") 'recherche du mot laurent dans l'exemple
If rep = "" Then Exit Sub
'Match

Set c = Sheets(1).Cells.Find("*" & rep & "*", LookIn:=xlValues)
If Not c Is Nothing Then
adresse1 = c.Address
Do
Range("B" & c.Row).Value = c.Value
Set c = Sheets(1).Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> adresse1
End If

'Copier coller de colonne VF1
Columns("D:D").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight

'Copier coller de colonne Enchainement
Columns("U:U").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight

'Copier coller de colonne localisation
Columns("T:T").Select
Selection.Copy
Columns("D:D").Select
Selection.Insert Shift:=xlToRight

'Copier coller de VF1 pour la cacher plus loin
Columns("G:G").Select
Selection.Copy
Columns("X:X").Select
Selection.Insert Shift:=xlToRight

' Mise en forme Macro

ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 15.8
Range("B9").Select
Columns("B:B").ColumnWidth = 30.5
Columns("B:B").ColumnWidth = 35.3
Columns("B:B").ColumnWidth = 39.4
Columns("C:C").ColumnWidth = 10.6
Columns("C:C").ColumnWidth = 9.2
Columns("D:D").ColumnWidth = 6.5
Range("A1:E1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1:E3062").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$GF$1678").AutoFilter Field:=2, Criteria1:="<>"

'MEF finale avec tri colonne enchainement
Columns("E:E").ColumnWidth = 20.4
Columns("E:E").ColumnWidth = 22.1
Columns("F:F").ColumnWidth = 35.7
Range("A3:E3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("C4:C3012").Select
ActiveWindow.ScrollRow = 2988
ActiveWindow.ScrollRow = 2983
ActiveWindow.ScrollRow = 2978
ActiveWindow.ScrollRow = 2948
ActiveWindow.ScrollRow = 2804
ActiveWindow.ScrollRow = 2729
ActiveWindow.ScrollRow = 2024
ActiveWindow.ScrollRow = 1780
ActiveWindow.ScrollRow = 1129
ActiveWindow.ScrollRow = 945
ActiveWindow.ScrollRow = 473
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 1
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add2 Key:=Range( _
"C1:C3012"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:GF3012")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$GF$1680").AutoFilter Field:=3, Criteria1:="<>"
Range("B1368").Select

'Et la deuxième est ta dernière macro avec m à la place de i pour éviter un doublon avec la 1ere macro du haut

Dim wb As Workbook, ws As Worksheet
Dim lastRow As Long, m As Long
Dim tbl As Variant

On Error GoTo errHandler

Set wb = ActiveWorkbook
Set ws = wb.Worksheets(1)

With ws
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
tbl = .Cells(4, 2).Resize(lastRow - 3).Value
For m = LBound(tbl) To UBound(tbl)
If VBA.InStr(tbl(m, 1), "TF") > 0 Then
tbl(m, 1) = WorksheetFunction.Substitute(tbl(m, 1), "TF", "TF ")
End If
Next m
.Cells(4, 2).Resize(lastRow - 3).Value = tbl
End With

exitHandler:
Set ws = Nothing: Set wb = Nothing
Exit Sub
errHandler:
MsgBox "Erreur : " & Err.Number & vbNewLine & Err.Description
Resume exitHandler

End Sub

Le 04/01/2022 à 11:20

Bonjour,

Ma dernière erreur venait que j'effectuai la macro décalage de caractères après que j'ai filtré des cellules. En faisant l'inverse, cela est revenu normal avec

le décalage de 5 caractères comme Jean Eric l'avait programmé. Pourquoi, je ne sais pas mais j'ai vu qu'il fallait d'abord faire les différentes extractions avant d'apporter une mise en forme finale.

Ma macro fonctionne enfin grâce à vous. Je vais gagner du temps dans mon travail de tous les jours au travail. Merci pour votre connaissances et aide que vous m'avez apportées.

Ce site est excellent, aussi bien pour les débutants que confirmés.

Bonne journée et peut être à la prochaine résolution de pb excel.

Laurent

Le 04/01/2022 à 17:07

Merci pour votre retour ! Et vos remerciements !

@ bientôt

LouReeD

Rechercher des sujets similaires à "decalage partie texte vba"