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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Public oWshMES As Object, oWshAVL As Object
Public MaPlage As Range, Ligne As Range, FichierTeste As Range, PrecVal As Variant
Sub essai()
'supprimer la mobilité de l ecran
Application.ScreenUpdating = False
vChemin = ThisWorkbook.Path + "\" 'chemin des fichiers
vFic(0) = vChemin + "mesg132.xlsx" 'fichiers à ouvrir
Workbooks.Open FileName:=vFic(0) 'ouverture fichier MES
Set oWshMES = ActiveWorkbook.Sheets("feuil1") 'active la variable
vDerligneMES = Cells(1000000, 1).End(xlUp).Row 'comptage nbre de ligne
'filtrer la colonne 12
oWshMES.Range("$A$1:$S$" & vDerligneMES).AutoFilter Field:=12, Criteria1:="P" '" & codeClient
If oWshMES.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
For I = 1 To vNbCentre
vNbMES(I) = 0
Next
Else
Set MaPlage = oWshMES.UsedRange.SpecialCells(xlCellTypeVisible)
'je compare les cellules de la colonne A
X = 1
For Each Ligne In MaPlage.Rows
Retour_Boucle3:
PrecVal = Ligne.Cells(8).Value 'ligne de visualisation pour debogage
If Ligne.Cells(1).Value = "CENTRE" Then GoTo Suite3
'cumul total de MES
If Ligne.Cells(1).Value = vCentre(X) Then vNbMES(X) = vNbMES(X) + 1
'Recherche si PCE déjà reperé
If RechercheAV([ligne.cells(8).value], Workbooks("toto.xlsm").Worksheets("Prochaine_Liste_RROBs").Range("c:g"), 2) = False Then
vNbRepereOK(X) = vNbRepereOK(X) + 1
End If
'changement de code centre
If Ligne.Cells(1).Value <> vCentre(X) Then X = X + 1: GoTo Retour_Boucle3
Suite3:
Next
End If
End Sub
'**********************************************************************************************************************
'**********************************************************************************************************************
' FONCTION de RECHERCHE
'**********************************************************************************************************************
'**********************************************************************************************************************
Public Function RechercheAV(Parm1 As Range, Parm2 As Range, Parm3 As Integer) As Boolean
Dim nada As Variant
On Error GoTo Err_Test
nada = Application.WorksheetFunction.VLookup(Parm1, Parm2, Parm3, False)
RechercheAV = True
Bye:
Exit Function
Err_Test:
RechercheAV = False
Resume Bye
End Function
'**********************************************************************************************************************
'**********************************************************************************************************************
'
'**********************************************************************************************************************
'********************************************************************************************************************** |
Partager