VBA Si la colonne contient

Bonjour,

Je souhaite faire évoluer une macro afin qu'elle puisse me faire gagner plus de temps dans mon quotidien.

Cependant je suis bloqué puisqu'il me faut utiliser une fonction SI combiner à un "contient".

Après de multiples recherches je suis tombé sur "If Application.WorksheetFunction.CountIf(Range("B:B"), 1) = "Test" Then".

Ma demande est comment utiliser cette fonction pour que, Si dans la colonne B (de la feuille 1 que j'ai activé juste avant le if) il y a écrit "Test" le programme effectue la tache suivante.

(Pour précision : "Test" contient des chiffres et des lettres")

Bien cordialement,

Bonjour

Un fichier est TOUJOURS le bienvenu....

A+ François

Bonjour,

Désolé de revenir vers vous si tard.

Je ne sais pas comment partager un fichier sans que des informations fuitent.

Je peux cependant partager mon code afin que la situation vous paraisse plus claire.

Dans un premier temps, sachez que je dois exploiter deux fichiers différents.

La seul différence entre eux et que l'un contient une source qui est unique tandis que l'autre contient jusqu'à trois sources.

Dans une premier temps je vous partagerai plus bas la macro de mon premier fichier qui se déroule comme je le souhaite.

Dans mon autre fichier, je veux qu'au moment ou mon tableau croisé dynamique se forme, il puisse me trier les sources ( qui sont : "NO1", "NO2" et "SI2")

Je voudrai donc pouvoir écrire "si la colonne C contient au moins une fois "NO1" faire : ..."

et pareillement pour NO2 et SI2 (je vous patage ce que je souhaite faire à la toute fin.

Apres lecture de la totalité de mon message je constate qu'il est quelque peu indigeste et j'en suis navré.

Cependant j'ai fait le maximum pour être le plus claire possible et vous prie ne pas m'en tenir rigueur.

Pour ceux qui auront le courage de me lire jusqua la fin, et même si vous ne me répondez pas, je vous remercie d'avant pour votre temps.

Précision:

Dans un premier temps j'ouvre mon fichier entete.

Ensuite j'ouvre mon fichier à traiter.

Je lance ma macro sur le fichier que je viens d'ouvrir.

Elle commence par de la mise en page

Elle fait un tableau croisé dynamique.

Elle ouvre un autre fichier sur lequel elle vient y coller mon tableau afin que je puisse garder ce que je souhaite dans celui-ci.

Elle ouvre ensuite encore un autre fichier ou elle vient y inserer des informations dont j'ai besoin.

Sub Pour excel pratique()

Dim wb As Workbook

Set wb = ActiveWorkbook
Set ws = ActiveSheet


wb.Activate
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("F:F").Select
Selection.NumberFormat = "0"
Windows("entete_fichier.xlsm").Activate
Rows("1:1").Select
Range("K1").Activate
Selection.Copy
wb.Activate
Range("A1").Select
ActiveSheet.Paste
Range("P1").Select
Application.CutCopyMode = False

Ligne0 = Cells(Rows.Count, 1).End(xlUp).Row

Selection.AutoFill Destination:=Range("P1:P" & Ligne0)
Range("P1:P" & Ligne0).Select
Columns("P:P").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("R1:R" & Ligne0)
Range("R1:R" & Ligne0).Select
Columns("R:R").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False

Dim rng As Range
Set rng = Selection

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, Version:=7).CreatePivotTable _
TableDestination:="", TableName:="Tableau croisé dynamique2", _
DefaultVersion:=7

With ActiveSheet.PivotTables("Tableau croisé dynamique2")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").RepeatAllLabels _
xlRepeatLabels
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Siret")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique2").PivotFields("Montant TTC"), _
"Somme de Montant TTC", xlSum
Columns("A:A").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_-* ###0_-;-* ###0_-;_-* ""-""??_-;_-@_-"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

"""""C'est ici que commence ce que vous verrez tout en bas.

'Passage fichier SUIVI

Dim Suivi As Workbook


On Error Resume Next

Set Suivi = Workbooks.Open("Ma source")

Set Suivi = Workbooks.Open("Autre personne l'utilise avec une autre source mais meme fichier")


Ligne = Cells(Rows.Count, 2).End(xlUp).Row


Sheets("detail suivi global,").Select
Rows(Ligne + 1).Select

Selection.Copy
Selection.Insert Shift:=xlDown
Range("B" & Ligne + 1).Activate
ActiveCell.Value = "fichier automatique"
Range("C" & Ligne + 1).Activate
ActiveCell.Value = Now()


wb.Activate
Selection.Copy
Suivi.Activate

Windows("Mon fichier suivi").Activate
Sheets("Feuil1").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("detail suivi global,").Select
Rows(Ligne + 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil1").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("detail suivi global,").Select

'Ligne du dessous Mettre la colonne qui correspond (dans le cas ou on ajoute un fournisseur)

'Il faut que je mette de nouveau "dernière ligne sur cette colonne pour alléger la chose"

Range("CI1744").Select
Selection.End(xlUp).Select
Selection.Copy

wb.Activate

Sheets("Feuil1").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


ws.Activate
'Sheets("fichier_manuel").Select
Rows("2:2").Select

Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Dim TOAD As Workbook


Set TOAD = Workbooks.Open(Mon autre source)

Set TOAD = Workbooks.Open(Celle de l'autre personne)




Windows("TOAD MANUEL").Activate

Ligne = Cells(Rows.Count, 1).End(xlUp).Row
Cells(Ligne + 1, 1).Select


Selection.Insert Shift:=xlDown

Ligne2 = Cells(Rows.Count, 2).End(xlUp).Row

Range("A" & Ligne).AutoFill Destination:=Range("A" & Ligne, "A" & Ligne2)

wb.Activate

Sheets("Feuil1").Activate
Range("C2").Select
Selection.Style = "Comma"
Selection.Copy

TOAD.Activate


Cells(Ligne2 + 6, 16).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Cells(Ligne2 + 6, 12).Select
ActiveCell.Value = "Fichier 000.. Au" & Now



'Windows("entete_fichier_.xlsm").Activate
End Sub

'

'

'

'

'

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""Voici maintenant le traitement que je souhaite faire avec mon autre fichier avec mes fonctions "Si la colonne contient au moins une fois"

'If InStr(Columns("C:C").Value, "NO2") >= 1 Then
If Columns("C").Value Like "NO2" Then

Sheets("Feuil1").Activate
Range("B1").Value = "NO2"
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("D3").Select
ActiveSheet.Paste
Else
MsgBox ("NON")

(je voudrais qu'il fasse rien mais j'ai mis msgbox pour le test)
End If

'

' End If


'ws.Activate

' If InStr(Cells(3, 3).Value, "SI2") > 0 Then
'If Application.WorksheetFunction.CountIf(Range("B:B"), "SI2") > 0 Then
'Range("B1").Value = "SI2"

' Sheets("Feuil1").Activate

'Range("B1").Value = "SI2"

' Range("A3").Select
' Range(Selection, Selection.End(xlToRight)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Copy
' Range("G3").Select
' ActiveSheet.Paste


'End If

'ws.Activate
'If InStr(Cells(3, 3).Value, "NO1") > 0 Then
'If Application.WorksheetFunction.CountIf(Range("B:B"), NO1) > 0 Then
'Sheets("Feuil1").Activate
'Range("B1").Value = "NO1"

'Else
'Range("A3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.ClearContents

'End If

' End If







' Dim Suivi As Workbook

'On Error Resume Next

' Set Suivi = Workbooks.Open(Ma source)

' Set Suivi = Workbooks.Open(L'autre)

' Sheets("Detail suivi").Select

' Ligne = Cells(Rows.Count, 2).End(xlUp).Row

'Rows(Ligne + 1).Select

'Selection.Copy
'Selection.Insert Shift:=xlDown
'Range("B" & Ligne + 1).Activate
'ActiveCell.Value = "fichier automatique"
'Range("C" & Ligne + 1).Activate
'ActiveCell.Value = Now()

'wb.Activate

'If Columns("C:C") = NO1 Then
'Range("A3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Copy
'Windows("00 Suivi interface Fournisseurs OTE_Fusion.xls").Activate
'Sheets("Feuil1").Select
'Range("A3").Select
'ActiveSheet.Paste
'End If

'wb.Activate
'If Columns("C:C") = NO2 Then
'Range("D3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Copy
'Windows("00 Suivi interface Fournisseurs OTE_Fusion.xls").Activate
'Sheets("Feuil1").Select
'Range("D3").Select
'ActiveSheet.Paste
'End If


'On Error Resume Next




'Sheets("Detail suivi").Select
'Rows(Ligne + 1).Select
'Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False

'Sheets("Feuil1").Select
'Application.CutCopyMode = False
'Selection.ClearContents
'Range("A3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.ClearContents
'Range("D3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.ClearContents
'Range("G3").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.ClearContents
'Sheets("Detail suivi OTE").Select



'Ligne du dessous Mettre la colonne qui correspond (dans le cas ou on ajoute un fournisseur)

'Range("AR1744").Select
'Selection.End(xlUp).Select
'Selection.Copy

Une petite idée?

Bonjour,

Pour éviter que les informations fuitent, il faut anonymiser les données sensibles, par exemple mettre des adresses mail bidons, changer les noms des personnes, modifier les montants, enlever le logo de l'entreprise... Mais garder la structure et la logique du fichier. Il n'est pas nécessaire d'avoir toutes les données du fichier non plus, tant que celles qui restent sont représentatives.

Personnellement je n'ai pas eu le courage de lire tout le code qui est très long.

PS:

Je pense que pour voir si la colonne B contient "Test", quelque chose comme ça pourrait servir:

https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.find

Si ça renvoie Nothing c'est qu'il n'y a pas "Test" dans la colonne, reste à voir les paramètres.

Bonjour,

En effet, cela sera plus simple avec un fichier modifié..

Voici donc mon entête ainsi que le fichier sur lequel je lance ma macro.

Je n'ai pas réussi à appliquer les fonctions présentent sur votre lien.

Ps : le code est raccourcis puisque je ne vous présente pas les autres fichiers qui sont ouvert par la suite mais qui fonctionne très bien avec le reste de la macro.

Bien cordialement,

4entete-test.xlsm (24.07 Ko)
5fichier-test.xlsx (14.72 Ko)

Si je comprends bien, il faut donc tester si ça contient NO1, NO2 et ainsi de suite, et faire des actions en fonction de si c'est le cas où non.

Je propose un bout de code que j'ai mis pile avant le pavé de commentaires.

18entete-test.xlsm (24.77 Ko)

L'idée c'est d'utiliser Range.Find avec What:="NO1", ça regardera si une cellule sur la plage fournie contient ou non cette valeur, elle renvoie une cellule si c'est le cas, et Nothing si ça ne trouve rien, donc je regarde juste si ça renvoie Nothing ou non. Je mets Not is Nothing pour dire "si ça contient ce que je cherche" ou encore "si ça trouve ce que je cherche" qui est plus proche de ce que j'ai écris.

J'espère que ça donnera un bout de piste

Bonjour,

Je tiens à vous remercier pour votre aider, cela m'a permis de débloquer ma situation.

Je mets le sujet en résolu.

Belle journée

Bonjour,

Merci pour le retour et pour avoir passé le sujet en résolu.

Bonne journée

Rechercher des sujets similaires à "vba colonne contient"