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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
| Sub PIVOT_TABEL_MAKEN()
Dim ws As Worksheet
Dim wsDest As Worksheet
Dim LastRow As Long
Dim LastRowDest As Long
Dim ColumnsToCopy As Variant
Dim col As Variant
Dim DestCol As Integer
Dim HeaderTitles As Variant
Dim i As Long
Dim TotalHours As Double
Dim TotalG As Double
Dim TotalF As Double
Dim TotalL As Double
Dim TotalM As Double
' Kolommen die gekopieerd moeten worden
ColumnsToCopy = Array("B", "C", "E", "F", "H", "I", "K", "M")
' Koptekst titels
HeaderTitles = Array("Achternaam", "Voornaam", "Datum", "Begin uur", "Eind uur", "Aanlog duur", "Actieve duur", "Schok", ">>>>>", "Aanlog duur", "Actieve duur")
' Maak een nieuw tabblad voor de samengevoegde gegevens
Set wsDest = ThisWorkbook.Sheets.Add
wsDest.Name = "PIVOT TABEL"
' Zet de kopteksten in de eerste rij van het nieuwe tabblad
For i = 0 To UBound(HeaderTitles)
wsDest.Cells(1, i + 1).Value = HeaderTitles(i)
Next i
' Formatteer de kopteksten
With wsDest.Range("A1:M1")
.Font.Size = 14
.Font.Bold = True
.Interior.Color = RGB(255, 255, 0) ' Geel
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
'.WrapText = True
wsDest.Columns("A:M").AutoFit
wsDest.Columns("A:M").HorizontalAlignment = xlCenter
End With
' Start de samengevoegde gegevens vanaf de 4de rij
LastRowDest = 4
' Loop door alle tabbladen en kopieer de specifieke kolommen zonder de kopteksten
' Alle tabs kopieeren ,behalve Tab 1 (Index 1) met de Evaluatiegegevens
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Evaluatieparameters" And ws.Name <> wsDest.Name Then
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
DestCol = 1
For Each col In ColumnsToCopy
If LastRow > 1 Then ' Controleer of er gegevens zijn om te kopiëren
ws.Range(ws.Cells(2, col), ws.Cells(LastRow, col)).Copy Destination:=wsDest.Cells(LastRowDest, DestCol)
End If
DestCol = DestCol + 1
Next col
LastRowDest = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row + 3 ' +3 voor TWEE lege regels toe te voegen tussen tabs
End If
Next ws
wsDest.Columns("A:M").AutoFit
' Maak alle sckokken in kolom H zichtbaar door rood te kleuren + vette cijfer
For i = 5 To LastRowDest - 1
If wsDest.Cells(i, 8).Value > 0 Then
wsDest.Cells(i, 8).Interior.Color = RGB(250, 0, 0) 'Maak cel Rood
With wsDest.Range("H" & i & ":H" & i)
.Font.Bold = True
.Font.Color = RGB(255, 255, 255) ' Maak cijfer wit
End With
End If
Next i
' Centreer de tekst in kolom G ,H ,I
wsDest.Columns("D:I").HorizontalAlignment = xlCenter
' Centreer de tekst in kolommen G tot en met P
wsDest.Columns("G:P").HorizontalAlignment = xlCenter
' Freeze de eerste rij
wsDest.Rows("2:2").Select
ActiveWindow.FreezePanes = True
Dim StartRow As Long
Dim EndRow As Long
Dim DataRange As Range
' Gebruik het actieve werkblad
Set ws = ActiveSheet
' Bepaal de laatste rij met gegevens in kolom A
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Begin bij de 4de rij, omdat de 1ste rij waarschijnlijk kopteksten bevat, 2de & 3de rij blank
StartRow = 4
For i = 4 To LastRow
' Als cel leeg is spring dan 3 rows
If ws.Cells(i, 1).Value = "" Then
With wsDest.Range("L" & EndRow - 1 & ":M" & EndRow - 1)
.Font.Size = 12
.Font.Bold = True
.Value = "Datums Totaal"
.Interior.Color = RGB(100, 250, 0) ' geel
End With
i = i + 2
StartRow = i
End If
' Vergelijk waarden in kolommen A, B en C met de volgende rij
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value And _
ws.Cells(i, 2).Value = ws.Cells(i + 1, 2).Value And _
ws.Cells(i, 3).Value = ws.Cells(i + 1, 3).Value Then
' Groep gaat door, ga naar de volgende rij
' Bereken de som van de waarden in kolom G en F ALS naam, voornaam en datum hetzelfde zijn (SOM als ABC=)
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value And _
ws.Cells(i, 2).Value = ws.Cells(i + 1, 2).Value And _
ws.Cells(i, 3).Value = ws.Cells(i + 1, 3).Value Then
TotalG = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(StartRow, 7), ws.Cells(i + 1, 7)))
TotalF = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(StartRow, 6), ws.Cells(i + 1, 6)))
End If
' Bereken de som van de waarden in kolom G en F ALS naam, voornaam hetzelfde zijn (SOM als AB=)
' Zo krijg je maandtotaal van deze persoon
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value And _
ws.Cells(i, 2).Value = ws.Cells(i + 1, 2).Value Then
TotalL = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(StartRow, 6), ws.Cells(i + 1, 6)))
TotalM = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(StartRow, 7), ws.Cells(i + 1, 7)))
End If
EndRow = i + 1
Else
' Stel de eindrij in als de huidige rij
EndRow = i
' Trek een vetgedrukt kader rond de groep in kolommen A tot en met H
Set DataRange = ws.Range("A" & StartRow & ":H" & EndRow)
With DataRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With DataRange.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With DataRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With DataRange.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With DataRange.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
' KLeur alle kolommen van G licht blauw
With wsDest.Range("G" & StartRow & ":G" & EndRow)
.Interior.Color = RGB(170, 216, 230) ' Licht_Blauw
End With
' KLeur alle kolommen van F licht groen
With wsDest.Range("F" & StartRow & ":F" & EndRow)
.Interior.Color = RGB(144, 238, 144) ' Licht_Groen
End With
' Verander eigenschappen voor cel J (Cel = Totaal Aangelogd duur)
With wsDest.Range("J" & EndRow - 1 & ":J" & EndRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 14
.Font.Bold = False
.Interior.Color = RGB(144, 238, 144) ' Licht_Groen
End With
' Verander eigenschappen voor cel K (Cel = Totaal Active duur)
With wsDest.Range("K" & EndRow - 1 & ":K" & EndRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 14
.Font.Bold = False
.Interior.Color = RGB(170, 216, 230) ' Licht_Blauw
End With
' vette kader rond J
Set Cell = ws.Range("J" & EndRow - 1 & ":J" & EndRow)
With Cell.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
' vette kader rond K
Set Cell = ws.Range("K" & EndRow - 1 & ":K" & EndRow)
With Cell.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
' Verander eigenschappen voor cel L en M
' Value = datums gekopieerd uit aatse Row, kolom C
With wsDest.Range("L" & EndRow - 1 & ":M" & EndRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 12
.Font.Bold = False
.Value = ws.Cells(EndRow, "C").Value
End With
' vette kader rond L en M
Set Cell = ws.Range("L" & EndRow - 1 & ":M" & EndRow)
With Cell.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
' Zet de som in kolom K voor kolom G en in kolom J (Totaal Aanlog duur)
' voor kolom F (Totaal Atieve duur)in de laatste rij van de groep
ws.Cells(i - 1, 11).NumberFormat = "[h]:mm:ss"
ws.Cells(i - 1, 11).Value = TotalG
ws.Cells(i - 1, 10).NumberFormat = "[h]:mm:ss"
ws.Cells(i - 1, 10).Value = TotalF
End If
Next i
MsgBox "De PIVOT TABEL is klaar ! Groeten Microman "
End Sub |
/u/28468/librarian2.png?f=community)
): beter is dan om of de opdracht terug te geven of eerst een cursus doen in de baas zn tijd. Het wordt namelijk kostbaar als later blijkt dat er een foutje in zat, bijv. bij een uitzonderingssituatie. Iets zegt me dat met die machines werken ook niet gebeurt door iemand die niet weet hoe het werkt en alleen een duwtje in de rug.
:strip_exif()/u/346082/crop6489c050bfe9d_cropped.gif?f=community)
/u/561650/crop5f73492aad711_cropped.png?f=community)