Is er een max. aantal regels dat er naar een array kan worden gelezen?
Krijg foutmelding 6 overloop bij onderstaande code.
Rapportage dat naar de array word gelezen bevat circa 100.000 regels.
Krijg foutmelding 6 overloop bij onderstaande code.
Rapportage dat naar de array word gelezen bevat circa 100.000 regels.
Code:
Dim sn, c As Range, dGeboorte As Date, dBegin As Date, sNaam As String, l As Long, WB As Workbook, splits, bOpen As Boolean
splits = Split("I:\StafDGR\FIA\Administratie\FinAdm\Werkinstructies en kostenplaatsen FA\C_rapportage labnota.xlsx ", "\")
On Error Resume Next
Set WB = Workbooks(splits(UBound(splits)))
bOpen = Not (WB Is Nothing)
If Not bOpen Then
Set WB = Workbooks.Open(Join(splits, "\"))
If WB Is Nothing Then
MsgBox "kan die file niet openen", vbCritical: Exit Sub
End If
End If
On Error GoTo 0
sn = WB.Worksheets(1).Range("A4").CurrentRegion 'kopie van je data-gegevens staan in dit blad en lees je naar een array
If Not bOpen Then WB.Close xlNo
For Each c In ActiveWorkbook.Sheets("orderregel").UsedRange.Columns("A").SpecialCells(xlConstants) 'loop alle namen af in je C-kolom
If c.Row > 1 Then
sNaam = c.Value
dGeboorte = c.Offset(, 1).Value
dBsn = c.Offset(, 2).Value
dBegin = c.Offset(, 6).Value 'begindatum staat 1 kolom naar rechts
c.Offset(, 4).Value = "Niet gevonden"
For l = 1 To UBound(sn) 'loop alle gegevens in je array af
If sn(l, 4) = dBsn And sn(l, 5) <= dBegin And (dBegin <= sn(l, 6) Or IsEmpty(sn(l, 6))) Then 'geboortedatum klopt, deel van de naam ook en valt binnen periode
Select Case sn(l, 8) 'onderzoek de mogelijke waarden van sn(l,10)
Case 403400 To 403470: c.Offset(, 4).Value = 403400 'ligt die hiertussen, dan schrijf je deze waarde weg
Case 403700 To 403770: c.Offset(, 4).Value = 403700 '2e mogelijkheid, andere waarde wegschrijven
Case 403800 To 403870: c.Offset(, 4).Value = 403800
Case 403900 To 403980: c.Offset(, 4).Value = 403900
Case 405700 To 405770: c.Offset(, 4).Value = 405720
Case 405800 To 405870: c.Offset(, 4).Value = 405820
Case 405900 To 405970: c.Offset(, 4).Value = 405920
Case 407640 To 407680: c.Offset(, 4).Value = 407100
Case 407700 To 407900: c.Offset(, 4).Value = 407100
Case 601100 To 602599: c.Offset(, 4).Value = 602600
Case 603200 To 603980: c.Offset(, 4).Value = 603170
Case Else: c.Offset(, 4).Value = sn(l, 8) 'in alle andere gevallen, de oorspronkelijke waarde wegschrijven
End Select
Exit For 'spring uit de loop
End If
Next
End If
Next
End Sub