Un bon livre pour amélioration code VBA adressé à mapomme et autres personnes trés compétentes

[JBARBE]

Bonjour mapomme, bonjour le forum,

J'ai toujours été en extase devant le travail accompli en VBA sur ce site par des personnes comme mapomme !

Je prends comme exemple la macro qu'il a faite ici :

__________________________________________________________________________

http://excel-downloads.com/threads/problème-à-résolutions-successives.20010922/page-2

Option Explicit

Sub ValCol()

Const FirstTournementColumn = "J" ' lettre de la première colonne des tournois

Dim ColDeb&, ColFin&, ligdeb&, ligfin&, k&, l&, topinit
Dim V(), C(), N, Dmin As Date, aux, s, xrg As Range
Dim auxTab(), tmpTab, i&, j&, plage As Range

On Error GoTo FIN 'en cas d'erreur, on réactive la détection des évènements
Application.EnableEvents = False

topinit = Timer
Application.ScreenUpdating = False
ColDeb = Range(FirstTournementColumn & "1").Column 'début des données (ligne)
ColFin = Cells(2, Columns.Count).End(xlToLeft).Column 'fin des données (ligne)
ligdeb = 4 'début des données (colonne)
ligfin = Cells(Rows.Count, "a").End(xlUp).Row 'fin des données (colonne)
Dmin = DateSerial(Year(Date) - 2, Month(Date), Day(Date)) 'Date lumite
N = ColFin - ColDeb + 1 'nombre de colonnes
ReDim V(1 To N): ReDim C(1 To N) ' création des tableaux des valeurs
' et des n° de colonnes associés
ReDim auxTab(ligdeb To ligfin, 1 To 2) ' création d'un tableau auxilliaire 'auxTab'


' -------------------------------------------------------------------------------------
' | MFC des premières colonnes |
' -------------------------------------------------------------------------------------
With Range(Cells(ligdeb, "a"), Cells(ligfin, "g"))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(SOMMEPROD(--($B$3:$B3<>$B$4:$B4));2)=1"
.FormatConditions(1).SetFirstPriority
.FormatConditions(1).Interior.Color = RGB(246, 255, 194)
.FormatConditions(1).StopIfTrue = False
End With


' -------------------------------------------------------------------------------------
' | traitement des colonnes des tournois |
' -------------------------------------------------------------------------------------

' on efface la couleur de fond des colonnes de tournois
Range(Cells(ligdeb, ColDeb), Cells(ligfin, ColFin)).Interior.ColorIndex = xlColorIndexNone
Application.ScreenUpdating = False

For k = ligdeb To ligfin
Set xrg = Range(Cells(k, ColDeb), Cells(k, ColFin)) 'range de la ligne en cours

For l = 1 To N 'boucle de remplissage des tableaux V et C
V(l) = 0 + xrg(1, l).Value
C(l) = 0 + xrg(1, l).Column
' si la date est postérieure à la date limite, V(j) est mis à 0
If xrg.Offset(2 - xrg.Row)(l) <= Dmin Then V(l) = 0
Next l

Do ' boucle pour trier v() du plus grand au plus petit (C suit le tri)
aux = False
For l = 1 To N - 1
If V(l) < V(l + 1) Then
aux = V(l): V(l) = V(l + 1): V(l + 1) = aux
aux = C(l): C(l) = C(l + 1): C(l + 1) = aux
aux = True
End If
Next l
Loop Until Not aux

s = 0: For l = 1 To 4: s = s + V(l): Next l 'somme des quatre plus grandes valeurs
auxTab(k, 1) = s 'écriture de cette somme dans le tableau
auxTab(k, 2) = s / 4 'écriture de la somme /4 dans le tableau
For l = 1 To 4 'coloration des cellules
' uniquement si la valeur associée n'est pas nulle
If V(l) > 0 Then Cells(k, C(l)).Interior.Color = RGB(255, 255, 144)
Next l
Next k

'écriture du tableau auxTab sur la feuille
Cells(ligdeb, ColDeb - 2).Resize(ligfin - ligdeb + 1, 2) = auxTab
ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = RGB(0, 0, 255)


' -------------------------------------------------------------------------------------
' | traitement des catégories d'âges |
' -------------------------------------------------------------------------------------

' lecture de la colonne des dates de naissance (attention! ligne 807 date fausse)
auxTab = Range(Cells(ligdeb, "g"), Cells(ligfin, "g")).Value
' lecture de la colonne des sexes
tmpTab = Range(Cells(ligdeb, "a"), Cells(ligfin, "a")).Value

For i = 1 To UBound(auxTab)
auxTab(i, 1) = tmpTab(i, 1) & categ(auxTab(i, 1))
Next i
Cells(ligdeb, "b").Resize(UBound(auxTab)) = auxTab


' -------------------------------------------------------------------------------------
' | traitement des positions |
' -------------------------------------------------------------------------------------
Dim tcat, tpos, tsco, Points, nIdem&
' tri de toutes les données
Set plage = Range(Cells(ligdeb, "a"), Cells(ligfin, ColFin))
plage.Sort key1:=Columns("b:b"), order1:=xlAscending, _
key2:=Columns("I:I"), order2:=xlDescending, _
Header:=xlNo

'tableau des points, des catégories, des scores
tcat = plage.Columns("B:B").Value
tpos = plage.Columns("C:C").Value
tsco = plage.Columns("I:I").Value

tpos(1, 1) = 1: nIdem = 1
For i = 2 To UBound(auxTab)
If tcat(i, 1) = tcat(i - 1, 1) Then
' même catégorie
If tsco(i, 1) = tsco(i - 1, 1) Then
' même cat , même valeur de points
tpos(i, 1) = tpos(i - 1, 1)
nIdem = nIdem + 1
Else
' même cat , les valeurs de points diffèrent
tpos(i, 1) = tpos(i - 1, 1) + nIdem
nIdem = 1
End If
Else
' la catégorie a changé
tpos(i, 1) = 1
nIdem = 1
End If
Next i
Range("c4").Resize(UBound(tpos)) = tpos


' -------------------------------------------------------------------------------------
' | traitement de fin de procédure |
' -------------------------------------------------------------------------------------

'MsgBox Format(Timer - topinit, "0.00\sec.")
Application.EnableEvents = True
Exit Sub

FIN:
Application.EnableEvents = True
MsgBox "Error n° " & Err.Number & " : " & Err.Description
End Sub

Sub AjoutJoueur()

Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo FIN
UserForm1.Show
Application.EnableEvents = True
Exit Sub

FIN:
Application.EnableEvents = True
End Sub

Sub AjoutTournoi()

On Error GoTo FIN:
Application.EnableEvents = False
Application.ScreenUpdating = False
Cells(1, Columns.Count).Delete 'pour s'assurer qu'il y a de la place pour insérer
Range("j:j").Insert xlShiftToRight, xlFormatFromRightOrBelow
Range("j:j").Interior.ColorIndex = xlColorIndexNone
Application.Goto Range("a1")
Range("j3").Select
MsgBox "Please, enter the values of the new tournament into column J."
Application.EnableEvents = True
Exit Sub
FIN:

Application.EnableEvents = True
MsgBox "An error occurs during the process to insert of a new tournament process." & vbLf & _
vbLf & "Error n° " & Err.Number & ": " & Err.Description
End Sub

__________________________________________________________________________
J'arrive à comprendre certaines lignes mais pour le reste c'est trés difficile !
Cette macro a la particularité de fonctionner trés vite par rapport à ce que j'ai présenté sur ce post !

Ainsi, mes bouquins VBA étant devenu obsolète, je demande à une personne comprenant cette macro ( bien sûr mapomme en fait partie ) de bien vouloir m'indiquer un bouquin VBA se rapportant à ce genre de programmation !

Ces bouquins qui m'ont appris la programmation sont :
programmation et algorithmique en VBA pour excel ( dunod)
programmation VBA pour excel 2007 pour les nuls (John Wakenbach)
VBA Excel 2003 - 2000 (Micro Application )

Cela me permettra d'améliorer mon VBA sur mes fichiers Excel crée et de satisfaire mon plaisir Excel !

ATTENTION : Ne pas me donner une référence avec une programmation trop simple à comprendre car j'ai eu ces notions avec ms anciens bouquins !

Merci à l'avance !