Explication code
D
bonjour a tous
Je sollicite votre afin de m'expliquer le code suivant car il ya quelque temps un membre ma creer ce code que j'utulise et fonctionnelle
mais maintenant que je m'interesse a VBA je souhaiterai comprendre
Merci de votre comprehension
rivate Sub CommandButton21_Click()
Dim sWk As Worksheet
Set sWk = Worksheets("Extract")
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
sWk.UsedRange.ClearContents
On Error Resume Next
'
iRowA = Range("A:A").Find(what:="TOTAL OVER", lookat:=xlWhole, searchdirection:=xlPrevious).Row
iRowAA = Range("A:A").Find(what:="OVERAGE RE", lookat:=xlWhole, searchdirection:=xlPrevious).Row
iRowD = Range("D:D").Find(what:="MPLOYEE", lookat:=xlPart, searchdirection:=xlPrevious).Row
'
Do While iOK = 0
iOK = 1
If iRowD1 < iRowD Then
iOK = 0
iOK1 = 0
iCol = iCol + 1 ' ˆ partir de la colonne A
sCol2 = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
iRowD1 = Range("D" & iRowD1 + 1 & ":D" & iRowD).Find(what:="MPLOYEE", lookat:=xlPart, searchdirection:=xlNext).Row + 1
iRowA1 = Range("A" & iRowD1 & ":A" & iRowA).Find(what:="TOTAL OVER", lookat:=xlWhole, searchdirection:=xlNext).Row
iRowAA1 = Range("A" & iRowD1 & ":A" & iRowA1).Find(what:="OVERAGE", lookat:=xlPart, searchdirection:=xlPrevious).Row
sData = Right(Cells(iRowD1, 4), Len(Cells(iRowD1, 4)) - 2)
sWk.Cells(2, iCol) = sData
sWk.Cells(3, iCol) = Cells(iRowD1, 5)
Do While iOK1 = 0
iOK1 = 1
If iRowAA2 < iRowAA1 Then
iOK1 = 0
iRowAA2 = Range("A" & IIf(iRowAA2 = 0, iRowD1, iRowAA2 + 1) & ":A" & iRowAA1).Find(what:="OVERAGE", lookat:=xlPart, searchdirection:=xlNext).Row
iRowAA3 = Range("A" & iRowAA2 + 1 & ":A" & iRowA1).Find(what:="RUN TIME", lookat:=xlPart, searchdirection:=xlNext).Row
iCol1 = Cells(iRowAA2 + 2, Columns.Count).End(xlToLeft).Column
For x = 2 To iCol1 Step 2
sCol1 = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
If Cells(iRowAA2 + 3, x) <> "" Then
For y = iRowAA3 To iRowAA2 + 3 Step -1
If Cells(y, x) <> "" And Len(Cells(y, x)) = 14 And IsNumeric(Left(Cells(y, x), 1)) And IsNumeric(Right(Cells(y, x), 1)) Then
iRow1 = y
Exit For
End If
Next
iRow2 = sWk.Range(sCol2 & Rows.Count).End(xlUp).Row + 1
sWk.Range(sCol2 & iRow2).Resize(iRow1 - (iRowAA2 + 2), 1).Value = Range(sCol1 & iRowAA2 + 3 & ":" & sCol1 & iRow1).Value
End If
Next
End If
iRowAA2 = iRowAA3
Loop
iRowAA2 = 0
End If
Loop
With sWk
For x = 1 To iCol
sCol = Split(.Columns(x).Address(ColumnAbsolute:=False), ":")(1)
iRow = .Range(sCol & Rows.Count).End(xlUp).Row
For y = iRow To 4 Step -1
If .Cells(y, x) = "" Then .Cells(y, x).Delete shift:=xlUp
Next
.Columns(sCol & ":" & sCol).ColumnWidth = 15
Next
.Activate
ActiveWindow.Zoom = 90
Cells.EntireColumn.AutoFit
End With
On Error GoTo 0
'
Application.EnableEvents = True
Application.ScreenUpdating = True