Bonjour à Tous,
J'ai du mal à mettre au point un code...
Dans le fichier excel joint, la feuille "AD" est la feuille de travail. Cette feuille donne des valeurs de poids nets ou de volume pour des références de produits alimentaires (colonne M).
Je dois faire figurer dans la colonne suivante "N" la plus petite des valeurs.
Le code utilisé est le suivant:
Sub Attributpardefaut()
Dim Racine As String
Dim wb As Workbook
Set wb = Workbooks("Catalogue_Reference.xlsm")
Dim feuille_AD As Worksheet
Set feuille_AD = wb.Worksheets("AD")
feuille_AD.Activate
Dim der_lig_AD As Long
der_lig_AD = Range("A65535").End(xlUp).Row
Dim plage, Nom, Valeurs As Range
Set plage = Range(Cells(1, 1), Cells(der_lig_AD, 14))
Dim k As Long
For i = 1 To der_lig_AD
k = i - 1
Dim tableau(90, 5) As Variant
Set Nom = plage.Cells(i + 1, 4)
Set Valeurs = plage.Cells(i + 1, 13)
tableau(k, 0) = Nom
tableau(k, 1) = Valeurs
Next i
For k = 0 To der_lig_AD
PositionTiret = InStr(1, tableau(k, 0), "-", vbTextCompare)
If PositionTiret > 0 Then
Racine = Left(tableau(k, 0), PositionTiret - 1)
tableau(k, 2) = Racine
If Left(tableau(k, 0), PositionTiret - 1) = Racine Then
If InStr(1, tableau(k, 1), "g", vbTextCompare) Then
tableau(k, 3) = Replace(tableau(k, 1), "g", "", 1, , vbTextCompare)
End If
If InStr(1, tableau(k, 1), "ml", vbTextCompare) Then
tableau(k, 3) = Replace(tableau(k, 1), "ml", "", 1, , vbTextCompare)
End If
ElseIf Left(tableau(k, 0), PositionTiret - 1) <> Racine Then
End If
ElseIf PositionTiret = 0 Then
End If
Next k
i = 1
Set plage = Range(Cells(1, 1), Cells(der_lig_AD, 14))
Set Nom = plage.Range(Cells(1, 4), Cells(der_lig_AD, 4))
Do
PositionTiret = InStr(1, Nom.Cells(i + 1, 1), "-", vbTextCompare)
If PositionTiret = 0 Then
Racine = Nom.Cells(i + 1, 1)
debut = Nom.Cells(i + 1, 1).Row
End If
debut_lignevaleurs = Nom.Cells(i + 1, 1).Offset(1, 0).Row
PositionTiret = InStr(1, Nom.Cells(i + 1, 1), "-", vbTextCompare)
If PositionTiret <> 0 Then
Do
i = i + 1
fin_lignevaleurs = Nom.Cells(i + 1, 1).Row
plage.Cells(debut, 14) = Application.Min(tableau(debut_lignevaleurs - 2, 3), tableau(fin_lignevaleurs - 2, 3))
Loop While Left(Nom.Cells(i + 1, 1), PositionTiret - 1) = Racine
ElseIf PositionTiret = 0 Then
Do
i = i + 1
fin_lignevaleurs = Nom.Cells(i + 1, 1).Row
plage.Cells(debut, 14) = Application.Min(tableau(debut_lignevaleurs - 2, 3), tableau(fin_lignevaleurs - 2, 3))
Loop While Nom.Cells(i + 1, 1) = Racine
End If
i = i + 1
Loop While fin_lignevaleurs <= der_lig_AD
End sub
Malheureusement, je n'arrive pas à aller au bout...et j'aurais bien besoin d'un coup de main pour le faire fonctionner
Merci d'avance,
J'ai du mal à mettre au point un code...
Dans le fichier excel joint, la feuille "AD" est la feuille de travail. Cette feuille donne des valeurs de poids nets ou de volume pour des références de produits alimentaires (colonne M).
Je dois faire figurer dans la colonne suivante "N" la plus petite des valeurs.
Le code utilisé est le suivant:
Sub Attributpardefaut()
Dim Racine As String
Dim wb As Workbook
Set wb = Workbooks("Catalogue_Reference.xlsm")
Dim feuille_AD As Worksheet
Set feuille_AD = wb.Worksheets("AD")
feuille_AD.Activate
Dim der_lig_AD As Long
der_lig_AD = Range("A65535").End(xlUp).Row
Dim plage, Nom, Valeurs As Range
Set plage = Range(Cells(1, 1), Cells(der_lig_AD, 14))
Dim k As Long
For i = 1 To der_lig_AD
k = i - 1
Dim tableau(90, 5) As Variant
Set Nom = plage.Cells(i + 1, 4)
Set Valeurs = plage.Cells(i + 1, 13)
tableau(k, 0) = Nom
tableau(k, 1) = Valeurs
Next i
For k = 0 To der_lig_AD
PositionTiret = InStr(1, tableau(k, 0), "-", vbTextCompare)
If PositionTiret > 0 Then
Racine = Left(tableau(k, 0), PositionTiret - 1)
tableau(k, 2) = Racine
If Left(tableau(k, 0), PositionTiret - 1) = Racine Then
If InStr(1, tableau(k, 1), "g", vbTextCompare) Then
tableau(k, 3) = Replace(tableau(k, 1), "g", "", 1, , vbTextCompare)
End If
If InStr(1, tableau(k, 1), "ml", vbTextCompare) Then
tableau(k, 3) = Replace(tableau(k, 1), "ml", "", 1, , vbTextCompare)
End If
ElseIf Left(tableau(k, 0), PositionTiret - 1) <> Racine Then
End If
ElseIf PositionTiret = 0 Then
End If
Next k
i = 1
Set plage = Range(Cells(1, 1), Cells(der_lig_AD, 14))
Set Nom = plage.Range(Cells(1, 4), Cells(der_lig_AD, 4))
Do
PositionTiret = InStr(1, Nom.Cells(i + 1, 1), "-", vbTextCompare)
If PositionTiret = 0 Then
Racine = Nom.Cells(i + 1, 1)
debut = Nom.Cells(i + 1, 1).Row
End If
debut_lignevaleurs = Nom.Cells(i + 1, 1).Offset(1, 0).Row
PositionTiret = InStr(1, Nom.Cells(i + 1, 1), "-", vbTextCompare)
If PositionTiret <> 0 Then
Do
i = i + 1
fin_lignevaleurs = Nom.Cells(i + 1, 1).Row
plage.Cells(debut, 14) = Application.Min(tableau(debut_lignevaleurs - 2, 3), tableau(fin_lignevaleurs - 2, 3))
Loop While Left(Nom.Cells(i + 1, 1), PositionTiret - 1) = Racine
ElseIf PositionTiret = 0 Then
Do
i = i + 1
fin_lignevaleurs = Nom.Cells(i + 1, 1).Row
plage.Cells(debut, 14) = Application.Min(tableau(debut_lignevaleurs - 2, 3), tableau(fin_lignevaleurs - 2, 3))
Loop While Nom.Cells(i + 1, 1) = Racine
End If
i = i + 1
Loop While fin_lignevaleurs <= der_lig_AD
End sub
Malheureusement, je n'arrive pas à aller au bout...et j'aurais bien besoin d'un coup de main pour le faire fonctionner
Merci d'avance,