Public Function cherche2(f As String, nomcolmois As String, strRMois As String, nomcolnoms As String, strRNom As String, nomColValeurs As String) As String Application.Volatile cherche2 = "Pas de données" Dim feuille As Worksheet Set feuille = Worksheets(f) Dim intNColNom As Integer, intNColVal As Integer Dim c As Range With feuille.Rows(1) Set c = .Find(nomcolmois, LookIn:=xlValues) If Not c Is Nothing Then intNColmois = c.Column Set c = .Find(nomcolnoms, LookIn:=xlValues) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(nomColValeurs, LookIn:=xlValues) If Not c Is Nothing Then intNColVal = c.Column End With derligne = feuille.Cells(Rows.Count, intNColmois).End(xlUp).Row Dim plage As Range, R As Range Set plage = feuille.Range(feuille.Cells(1, intNColmois), feuille.Cells(derligne, intNColmois)) For Each c In plage If c.Value strRMois And feuille.Cells(c.Row, intNColNom).Text strRNom Then cherche2 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Next Set feuille = Nothing Set c = Nothing End Function
Public Function cherche2(f As String, ByVal strRmois As Range, ByVal strRNom As Range, ByVal nomColValeurs As Range, Optional nomcolmois As String "Mois", Optional nomcolnoms As String "Nom") As String Application.Volatile cherche2 = "Pas de données" Dim feuille As Worksheet Set feuille = Worksheets(f) Dim intNColNom As Integer, intNColVal As Integer, c As Range With feuille.Rows(1) Set c = .Find(nomcolmois, LookIn:=xlValues) If Not c Is Nothing Then intNColmois = c.Column Set c = .Find(nomcolnoms, LookIn:=xlValues) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(nomColValeurs, LookIn:=xlValues) If Not c Is Nothing Then intNColVal = c.Column End With derligne = feuille.Cells(Rows.Count, intNColmois).End(xlUp).Row Dim plage As Range, R As Range Set plage = feuille.Range(feuille.Cells(1, intNColmois), feuille.Cells(derligne, intNColmois)) For Each c In plage If c.Value strRmois And feuille.Cells(c.Row, intNColNom).Text strRNom Then cherche2 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Next Set feuille = Nothing Set c = Nothing End Function
Sheets(Nom).Range("A1", Range("A1").End(xlDown))
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionsub test() Application.ScreenUpdating =false Sheets("DONNEE").Activate 'Ta macro..... Sheets("DONNEE").Range(Range("A1").End(xlDown)) '.... 'à la fin tu réactives ton autre feuille Sheets("feuil?").Activate Application.ScreenUpdating =true 'Pour éviter les changements de feuilles intempestifs
Private (ou Public) Function essai(feuille as worksheet) as string essai = feuille.range("A1", Range("A1").End(xlDown)).Address end function
msgbox essai(worksheets("Feuil1"))
Dim strNFeuil as string strNFeuil = rgDonnee.Worksheet.name With Worksheets(strNFeuil).Range(Range("A1").End(xlDown), Range("A1").End(xlToRight))
et
Function Recherche_Val(rgDonnee As Range, RMois As String,_ RCol As String, RNom As String)as long Dim rgMois As Range, rgNom As Range, rgCol As Range Dim intLrgMois As Integer, intLrgNom As Integer, intNcol As Integer Dim i As Integer, a As Integer Dim TabLmois() As Variant Dim strNFeuil as string strNFeuil = rgDonnee.Worksheet.name With Worksheets(strNFeuil).Range(Range("A1").End(xlDown), Range("A1").End(xlToRight)) 'Trouve le numero de colonne de la valeur a chercher Set rgCol = .Find(RCol, LookIn:=xlValues) If Not rgCol Is Nothing Then intNcol = rgCol.Column Else Recherche_Val = "Pas de donnees" End End If 'Trouve toutes les lignes du même mois et les enregistrer dans un tableau i = 0 Set rgMois = .Find(RMois, LookIn:=xlValues) If Not rgMois Is Nothing Then intLrgMois = rgMois.Row Do ReDim Preserve TabLmois(i) TabLmois(i) = rgMois.Row i = i + 1 Set rgMois = .FindNext(rgMois) Loop While Not rgMois Is Nothing And rgMois.Row <> intLrgMois End If a = i i = 0 End With 'Vérifier pour chaque ligne si le nom existe Do With Worksheets(strNFeuil).Cells(TabLmois(i), 1).EntireRow Set rgNom = .Find(RNom, LookIn:=xlValues) If rgNom Is Nothing Then i = i + 1 End With Loop While rgNom Is Nothing And i < a If Not rgNom Is Nothing Then intLrgNom = rgNom.Row Recherche_Val = Sheets(strNFeuil).Cells(intLrgNom, intNcol).Value Else Recherche_Val = "Pas de donnees" End If End Function
J'ai typé ma fonction en Long car j'ai des calculs à faire par la suite avec ces résultats.
Recherche_Val = "Pas de donnees"
Private Sub CommandButton1_Click() Dim nom As String, mois As String, feuille As Worksheet, colmois As String, colnom As String MsgBox cherche(Worksheets("Feuil1"), "A", "D", 3, "jacques") End Sub Private Function cherche(feuille As Worksheet, colmois As String, colnom As String, mois As Integer, nom As String) As String Dim dercolmois As Long, dercolnom As Long cherche = "pas trouvé" dercolmois = feuille.Range(colmois & Rows.Count).End(xlUp).Row dercolnom = feuille.Range(colnom & Rows.Count).End(xlUp).Row If dercolmois < dercolnom Then dercolmois = dercolnom With feuille.Range(col & "1:" & col & dercolmois) Dim c As Range Set c = .Find(mois, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do Set c = .FindNext(c) If Not c Is Nothing And .Range(colnom & c.Row) = nom Then cherche = c.Row: Exit Function End If Loop While Not c Is Nothing And c.Address <> firstAddress End If End With End Function
Private Function cherche1(feuille As Worksheet, strRMois As String, strRNom As String, ColValeur As String) As String cherche1 = "Pas de données" 'Trouver les numéros des colonne Utilisés Dim intNColNom As Integer, intNColVal As Integer Dim c As Range With feuille.Rows(1) Set c = .Find("Nom", LookIn:=xlValues) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(ColValeur, LookIn:=xlValues) If Not c Is Nothing Then intNColVal = c.Column End With With feuille.Range("A1", Range("A1").End(xlDown)) Dim firstaddress As String Set c = .Find(strRMois, LookIn:=xlValues) If Not c Is Nothing Then firstaddress = c.Address Do Set c = .FindNext(c) If Not c Is Nothing And .Cells(c.Row, intNColNom) = strRNom Then cherche1 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Loop While Not c Is Nothing And c.Address <> firstaddress End If End With End Function
Private Sub CommandButton1_Click() Dim titre1 As String, val_cherchee_titre1 As String Dim titre2 As String, val_cherchee_titre2 As String Dim titre3 As String Dim lafeuille As Worksheet Set lafeuille = Worksheets("Feuil1") titre1 = "Mois" titre2 = "Nom" titre3 = "Valeur" val_cherchee_titre1 "3" '>> si tes mois sont des nombres val_cherchee_titre2 = "b" MsgBox cherche1(lafeuille, titre1, val_cherchee_titre1, titre2, val_cherchee_titre2, titre3) ' ' mais rien ne t'empêcherait d'appeler ainsi, directement, dans tout ce qui précède 'MsgBox cherche1(Worksheets("Feuil1"), "Mois", "3", "Nom", "b", "Valeur") End Sub Private Function cherche1(feuille As Worksheet, nomcolmois As String, strRMois As String, nomcolnoms As String, strRNom As String, nomColValeurs As String) As String cherche1 = "Pas de données" Dim intNColNom As Integer, intNColVal As Integer Dim c As Range With feuille.Rows(1) Set c = .Find(nomcolmois, LookIn:=xlValues) If Not c Is Nothing Then intNColmois = c.Column Set c = .Find(nomcolnoms, LookIn:=xlValues) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(nomColValeurs, LookIn:=xlValues) If Not c Is Nothing Then intNColVal = c.Column End With derligne = feuille.Cells(Rows.Count, intNColmois).End(xlUp).Row With Range(Cells(1, intNColmois), Cells(derligne, intNColmois)) Dim firstaddress As String Set c = .Find(strRMois, LookIn:=xlValues) If Not c Is Nothing Then firstaddress = c.Address Do Set c = .FindNext(c) If Not c Is Nothing And .Cells(c.Row, intNColNom) = strRNom Then cherche1 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Loop While Not c Is Nothing And c.Address <> firstaddress End If End With End Function
derligne = feuille.Cells(Rows.Count, intNColmois).End(xlUp).Row With Range(Cells(1, intNColmois), Cells(derligne, intNColmois))
With feuille.Range("A1", Range("A1").End(xlDown))
Set c = .Find(nomcolnoms, LookIn:=xlValues, LookAt:=xlWhole)
Private Function cherche1(feuille As Worksheet, strRMois As String, strRNom As String, _ strNomColVal As String, ColMois As String, ColNom As String) As String cherche1 = "Pas de données" Dim strNomColMois, strNomColNom If ColMois "" Then strNomColMois "Mois" If ColNom "" Then strNomColNom "Nom" 'Trouver les numéros des colonne Utilisés Dim intNColNom As Integer, intNColVal As Integer, intNColMois As Integer Dim c As Range With feuille.Rows(1) Set c = .Find(strNomColNom, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(strNomColVal, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then intNColVal = c.Column Set c = .Find(strNomColMois, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then intNColMois = c.Column End With Dim intNLigne As long intNLigne = feuille.Cells(Rows.Count, intNColMois).End(xlUp).Row With Range(Cells(1, intNColMois), Cells(intNLigne, intNColMois)) Dim firstaddress As String Set c = .Find(strRMois, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do Set c = .FindNext(c) If Not c Is Nothing And .Cells(c.Row, intNColNom) = strRNom Then cherche1 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Loop While Not c Is Nothing And c.Address <> firstaddress End If End With End Function
Private Function cherche1(feuille As Worksheet, nomcolmois As String, strRMois As String, nomcolnoms As String, strRNom As String, nomColValeurs As String) As String cherche1 = "Pas de données" Dim intNColNom As Integer, intNColVal As Integer Dim c As Range With feuille With .Rows(1) Set c = .Find(nomcolmois, LookIn:=xlValues) If Not c Is Nothing Then intNColmois = c.Column Set c = .Find(nomcolnoms, LookIn:=xlValues) If Not c Is Nothing Then intNColNom = c.Column Set c = .Find(nomColValeurs, LookIn:=xlValues) If Not c Is Nothing Then intNColVal = c.Column End With derligne = .Cells(Rows.Count, intNColmois).End(xlUp).Row With feuille.Range(.Cells(1, intNColmois), .Cells(derligne, intNColmois)) Dim firstaddress As String Set c = .Find(strRMois, LookIn:=xlValues) If Not c Is Nothing Then If feuille.Cells(c.Row, intNColNom).Text = strRNom Then cherche1 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If firstaddress = c.Address Do Set c = .FindNext(c) If Not c Is Nothing And feuille.Cells(c.Row, intNColNom).Text = strRNom Then ' Then cherche1 = feuille.Cells(c.Row, intNColVal).Value: Exit Function End If Loop While Not c Is Nothing And c.Address <> firstaddress End If End With End With End Function
With feuille.Range(.Cells(1, intNColmois), .Cells(derligne, intNColmois))
With Range(Cells(1, intNColMois), Cells(intNLigne, intNColMois))