Macro dans une colonne et non la page

Le 17/08/2017 à 22:02

Bonjour,

J'ai une question toute bête !

J'ai une macro qui fait de find et replace mais elle l'a fait dans toutes les pages et toutes les colonnes de mon excel.

Par contre je veux qu'elle change seulement dans une colonne bien précise.

Serait-ce possible de modifier la macro pour qu'elle change juste la colonne B par exemple.

Est-ce que c'est possible aussi qu'elle fasse le fin et replace mais sur plusieurs fichiers excel en même temps si oui comment cela fonctionne ???

MERCI

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: http://www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table

  Set tbl = Worksheets("Feuil3").ListObjects("Table2")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)

'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then

          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

        End If
      Next sht
  Next x

End Sub
Le 18/08/2017 à 01:48

Bonjour,

à tester,

Sub MyReplace()
Dim fd As FileDialog
Dim oFile As Object, oFolder As String
Dim wk1 As Workbook, wk2 As Workbook
Set wk1 = ThisWorkbook
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

 With fd
    .AllowMultiSelect = False
    .Show
    oFolder = .SelectedItems(1)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sfoFolder = fso.getfolder(oFolder)

    For Each oFile In sfoFolder.Files
     If Right(oFile, 4) = ".xls" Then
        Workbooks.Open oFile
        Set wk2 = ActiveWorkbook

        'Loop through each item in Array lists
        For x = LBound(myArray, 1) To UBound(myArray, 2)
        'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
             For Each sht In wk2.Worksheets
                If sht.Name <> tbl.Parent.Name Then
                     wk2.sht.Range("B:B").Replace What:=myArray(fndList, x), LookAt:=xlPart, MatchCase:=False
                End If
            Next sht
        Next x

        wk2.Close SaveChanges:=True
        Set wk2 = Nothing

     End If
    Next oFile

'   Pour inclure les sous-dossiers
'   For Each d In Dossier.SubFolders
'    Read_File1 d
'   Next

 End With 'fd
End Sub
Le 18/08/2017 à 08:11

Bonjour,

J'ai un peu simplifié le code, voir les commentaires pour mieux comprendre. Le remplacement ne se fait que sur une feuille (ici "Feuil1") et seulement en colonne B :

Sub Multi_FindReplace()

    Dim fndList As Integer
    Dim rplcList As Integer
    Dim tbl As ListObject
    Dim myArray As Variant
    Dim X As Integer

    'le tableau se situe en feuille "Feuil2" et nommé "Table2", à adapter...
    'il est possible de renommer le tableau :
    'Worksheets("Feuil2").ListObjects("Table2").Name="Le_Nom_Que_Tu_Veux"
    Set tbl = Worksheets("Feuil2").ListObjects("Table2")

    myArray = Application.Transpose(tbl.DataBodyRange)

    'Designate Columns for Find/Replace data
    fndList = 1 'colonne des mots recherchés
    rplcList = 2 'colonne des mots de remplacement

    'la recherche/remplacement se fait seulement sur la colonne B ("Columns(2)") de la feuille "Feuil1", à adapter...
    For X = LBound(myArray, 1) To UBound(myArray, 2)

        Worksheets("Feuil1").Columns(2).Cells.Replace myArray(fndList, X), myArray(rplcList, X), xlPart, xlByRows, False, False, False

    Next X

End Sub

Oups,

J'ai oublié la partie recherche de fichiers mais sabV a bien répondu là dessus !

Le 18/08/2017 à 09:22

Bonjour,

Une autre proposition à étudier.

Tous les fichiers sont dans le même répertoire.

Cdlt.

Public Sub Multi_Find_Replace()
Dim wb As Workbook
Dim wsList As Worksheet
Dim sPath As String, sFilename As String
Dim tbl As Variant
Dim I As Long
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    sPath = wb.Path & Application.PathSeparator
    sFilename = Dir(sPath, "*.xlsx")
    Set wsList = wb.Worksheets("List")
    tbl = wsList.ListObjects(1).DataBodyRange
    While sFilename <> ""
        If sFilename <> wb.Name Then
            Workbooks.Open (sPath & sFilename)
            With ActiveWorkbook
                For I = LBound(tbl) To UBound(tbl)
                    .Worksheets(1).Columns(2).Cells.Replace tbl(I, 1), tbl(I, 2)
                Next I
                .Close savechanges:=True
            End With
        End If
        sFilename = Dir
    Wend
    Set wsList = Nothing: Set wb = Nothing
End Sub
Le 18/08/2017 à 17:08
Theze a écrit :

Bonjour, ça fonctionne bien pour une feuille Merci !!

J'ai un peu simplifié le code, voir les commentaires pour mieux comprendre. Le remplacement ne se fait que sur une feuille (ici "Feuil1") et seulement en colonne B :

Sub Multi_FindReplace()

    Dim fndList As Integer
    Dim rplcList As Integer
    Dim tbl As ListObject
    Dim myArray As Variant
    Dim X As Integer

    'le tableau se situe en feuille "Feuil2" et nommé "Table2", à adapter...
    'il est possible de renommer le tableau :
    'Worksheets("Feuil2").ListObjects("Table2").Name="Le_Nom_Que_Tu_Veux"
    Set tbl = Worksheets("Feuil2").ListObjects("Table2")

    myArray = Application.Transpose(tbl.DataBodyRange)

    'Designate Columns for Find/Replace data
    fndList = 1 'colonne des mots recherchés
    rplcList = 2 'colonne des mots de remplacement

    'la recherche/remplacement se fait seulement sur la colonne B ("Columns(2)") de la feuille "Feuil1", à adapter...
    For X = LBound(myArray, 1) To UBound(myArray, 2)

        Worksheets("Feuil1").Columns(2).Cells.Replace myArray(fndList, X), myArray(rplcList, X), xlPart, xlByRows, False, False, False

    Next X

End Sub

Oups,

J'ai oublié la partie recherche de fichiers mais sabV a bien répondu là dessus !

Le 24/08/2017 à 08:38

Bonjour à tous,

oly111, votre question était la suivante:

J'ai une macro qui fait de find et replace mais elle l'a fait dans toutes les pages et toutes les colonnes de mon excel.

Par contre je veux qu'elle change seulement dans une colonne bien précise.

Serait-ce possible de modifier la macro pour qu'elle change juste la colonne B par exemple.

maintenant vous dite:

Le remplacement ne se fait que sur une feuille (ici "Feuil1") et seulement en colonne B :

pourtant les propositions qui ont été faites répondent à cette demande, s.v.p dites nous plus précisément quel est votre difficulté à appliquer ces propositions.

peut-être pourriez-vous joindre votre fichier (*.xlsm) ou (*.xls) incluant votre code.

Rechercher des sujets similaires à "macro colonne page"