Si cellule contient XX alors - vba

[gramy]

Bonjour à toute la communauté.

Je suis en train de modifier 1 de mes scripts vba et je bute sur un problème de taille....

Je vous explique :
J'ai un fichier .csv que je récupère pour créer un fichier .xlsx
Jusque là pas de soucis.
Je créé mon fichier blabla_ & sDashedDate
je créé 2 onglets : mes datas bruts dans la sheets 2 et un tableau croisé dynamic dans la sheet 1.

J'ai une donnée dans ma sheet 2 que je n'intègre pas dans mon TDC dans la sheet 1.

Mon problème est le suivant:
Je cherche à récupérer dans la sheet 2 dans le Range(B:B) tout ce qui va contenir XX.
Ceci fait je veux récupérer les données dans la céllule précedant ce que je viens de trouver (ex: je trouve XX en B17 je récupère la valeur A17) pour ensuite colorer la cellule de mon TDC en sheet 1.

Je ne sais pas si c'est vraiment compréhensible

Merci d'avance pour vos retours.

Gramy

 

[Lone-wolf]

Re : Si cellule contient XX alors - vba

Bonjour gramy,

personnellement je ne peux pas t'aider. Mais le fichier en question en pièce jointe, si tu veux avoir de l'aide plus rapidement.

 

[gramy]

Re : Si cellule contient XX alors - vba

Du coup je pense que je vais partir sur la création d'un 3ème onglet temporaire pour récupérer les données et ensuite taguer ca dans mon TDC.

 

[gramy]

Re : Si cellule contient XX alors - vba

Je vous colle mon code de base ca sera plus simple :

Attribute VB_Name = "toto"
Public CodeErreur As String
Const InputFile As String = "toto.csv"
Public Const OutputFile As String = "toto"
Sub Launch_toto()

Call AddReference
Call Generate_toto_Report

End Sub

Sub DisplayIt(Optional sDate As String = Empty)

Progressindicator.Show

End Sub

Sub Generate_toto_Report(Optional sDate As String = Empty, Optional CSVFilePath As Variant = Empty)

On Error GoTo errorHandler
Application.DisplayAlerts = False
progress 5
Application.ScreenUpdating = False

Call AddReference

Dim sDashedDate As String

If sDate <> "" Then
progress 10

sDashedDate = Format(sDate, "yyyy-mm-dd")

If OutputExists(sDashedDate) Then GoTo customExit

Set oFSO = New Scripting.FileSystemObject

progress 15
CSVFilePath = "\\server\XXX\YYYY\" & sDashedDate & "\" & InputFile

If Not oFSO.FileExists(CSVFilePath) Then CSVFilePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , , , False)

End If

' Import CSV
progress 20
If CSVFilePath = "" Then CSVFilePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , , , False)

If CSVFilePath = False Then
GoTo customExit
Else
Call ImportCSV(CSVFilePath)
End If
progress 25

' Récupération date des logs
If sDate = "" Then
Do
sDate = InputBox("Please enter logs date (JJ/MM/AAAA)", , Format(Now - 1, "dd/mm/yyyy"))
Loop Until Mid(sDate, 3, 1) = "/" And Mid(sDate, 6, 1) = "/"
End If
progress 30

sDashedDate = Format(sDate, "yyyy-mm-dd")

If OutputExists(sDashedDate) Then GoTo customExit

If Cells(1, 1) = "" And Cells(1, 2) = "" And Cells(2, 1) = "" And Cells(2, 2) = "" Then GoTo noDataExit

progress 35
Columns("D").Select
Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, , , xlYes).Name = "RawData"
progress 40
Range("RawData[#All]").Select
ActiveSheet.ListObjects("RawData").TableStyle = "TableStyleMedium9"

Cells.Select
Cells.EntireColumn.AutoFit
Call DeleteUselessSheets

progress 45
Range("RawData[[#Headers],[event_time]]").Select

iCol = 1

While Cells(1, iCol) <> ""
If Columns(iCol).ColumnWidth > 80 Then Columns(iCol).ColumnWidth = 80
iCol = iCol + 1
progress 50
Wend

ActiveSheet.Name = "Raw Data"

' Création TCD
Sheets.Add Before:=Worksheets(1)
progress 55
Sheets(1).Name = "AccessPorn_" & sDashedDate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"RawData", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="'XX_" & sDashedDate & "'!R3C1", TableName:="TCD", _
DefaultVersion:=xlPivotTableVersion14
Sheets(1).Select
Cells(3, 1).Select

progress 60
With ActiveSheet.PivotTables("TCD").PivotFields("user_dst")
.Orientation = xlRowField
.Position = 1

End With
With ActiveSheet.PivotTables("TCD").PivotFields("event_time")
.Orientation = xlRowField
.Position = 2

progress 65
End With
With ActiveSheet.PivotTables("TCD").PivotFields("referer")
.Orientation = xlRowField
.Position = 3

End With

With ActiveSheet.PivotTables("TCD").PivotFields("url")
.Orientation = xlRowField
.Position = 4

End With

progress 70
ActiveSheet.PivotTables("TCD").AddDataField ActiveSheet. _
PivotTables("TCD").PivotFields("disposition"), _
"Nombre de url", xlCount

ActiveSheet.PivotTables("TCD").PivotFields("user_dst").ShowDetail = False
Range("B:B").Select
ActiveSheet.PivotTables("TCD").PivotFields("user_dst").AutoSort _
xlDescending, "Nombre de url", ActiveSheet.PivotTables("TCD"). _
PivotColumnAxis.PivotLines(1), 1

progress 90
Range("A1").Select

If Columns("A:A").ColumnWidth > 80 Then
Columns("A:A").ColumnWidth = 80
End If

Range("A3").Select

Set oFSO = New Scripting.FileSystemObject
If Not oFSO.FolderExists(sResultsPath & sDashedDate) Then oFSO.CreateFolder (sResultsPath & sDashedDate)

ActiveWorkbook.SaveAs Filename:= _
sResultsPath & sDashedDate & "\" & GetOutputFile(sDashedDate), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

GoTo customExit

errorHandler:
CodeErreur = OutputFile & " - " & Err.Number & " - " & Err.Description
Debug.Print CodeErreur
Application.DisplayAlerts = False
ThisWorkbook.Close

GoTo customExit

noDataExit:
Call NoData(sDashedDate, OutputFile)
GoTo customExit

customExit:
progress 100
Progressindicator.Hide

End Sub

PS: désolé pour le double post

 

[gramy]

Re : Si cellule contient XX alors - vba

je vous joins un fichier en exemple.
Pour résumer j'aimerais coloré dans le TDC de la feuille 1 si Toto apparait pour 1 user dans la feuille "Raw Data"
Et si possible pouvoir intégrer ceci au code précédemment donné.

Merci pour votre aide

 

[gramy]

Re : Si cellule contient XX alors - vba

J'ai réussi à m'en sortir (je devais ne pas être très en forme quand j'ai buté là dessus).....
J'ai simplement récupérer les données avec un "find", j'ai ensuite supprimé les doublons

ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

puis j'ai fait un cut/copy sur ma page principale où se trouvaient les données à colorer.

Ensuite j'ai coder la comparaison entre cellules comme ca :

Sub colore()

Dim rep As Range
Dim i As Integer
Dim k As String

For i = 4 To 30000
k = Cells(i, 1).Value
Set rep = Range("D2100").Find(what:=k)
If Not rep Is Nothing Then
Cells(i, 1).Interior.Color = 255 ' ROUGE
End If
Next i
End Sub

Tout simplement......