Beste allemaal,
In het proces om het verzamelen van data van verschillende werkbladen te automatiseren, stuitte ik op een probleem waar ik zelf niet verder mee kan komen. De sub ziet er als volgt uit:
De essentie van de macro is het verzamelen van alle benodigde gegevens, zoals aangegeven in de tabellen hierboven. Eerst gebruikte ik de 'SSR', een globaal zoekveld voor alle .find functies die ik gebruik, maar aangezien alle namen drie keer voorkomen is dat geen optie. Daarom gebruik ik de variabele 'CorrectRange' om het adres van de rij waarin het stalnummer staat te vinden en vervolgens het zoekgebied te vergroten tot CorrectHeight en CorrectWidth. Het probleem is echter dat dit niet werkt; LocalSSR geeft namelijk als waarde 'leeg' aan.
Heeft iemand hier misschien een oplossing voor?
In het proces om het verzamelen van data van verschillende werkbladen te automatiseren, stuitte ik op een probleem waar ik zelf niet verder mee kan komen. De sub ziet er als volgt uit:
Code:
Sub Gather()
Dim StallIndex As Integer
For StallIndex = 2 To 4
SSR = "A1:AT40"
EmptyCell(1) = ""
EmptyCell(2) = " "
EmptyCell(3) = " "
'Bepaal actief werkblad nummer
Dim n As Integer
n = ActiveSheet.Index
'Vind het juiste stalnummer
Dim CorrectRange As Range
Set CorrectRange = Sheets(n).Range(SSR).Find("Stal " & StallIndex & ": Leeftijd (weken)", lookat:=xlPart)
'Bepaal de rij waarin het correcte stalnummer zich bevindt
Dim CorrectRow As Range
Set CorrectRow = Range(CorrectRange.Row & ":" & CorrectRange.Row)
'Aantal kolommen waarin data aanwezig is
Dim CorrectWidth As Integer
CorrectWidth = Application.WorksheetFunction.CountIfs(CorrectRow, ">0", CorrectRow, "<101")
'Aantal rijen waarin data aanwezig is
Dim CorrectHeight As Integer
CorrectHeight = 0
For h = 1 To 100
If IsInArray(Sheets(n).Range(CorrectRange.Address).Offset(h, 0).Value, EmptyCell) = False Then
CorrectHeight = CorrectHeight + 1
Else
Exit For
End If
Next h
Dim LocalSSR As Range
Set LocalSSR = Range(CorrectRange.Address).Resize(CorrectHeight, CorrectWidth)
Dim SearchItem() As String
ReDim SearchItem(1 To CorrectHeight)
For g = 1 To CorrectHeight
SearchItem(g) = Sheets(n).Range(CorrectRange.Address).Offset(g, 0).Value
Next g
For j = 1 To CorrectHeight
On Error Resume Next
Dim StartCell1 As Range
Set StartCell1 = Sheets(n).Range(LocalSSR).Find(SearchItem(j), lookat:=xlPart)
Dim SourceCell1 As Range
If StartCell1 Is Nothing Then
MsgBox ("Een item van " & SearchItem(j) & " kon niet gevonden worden. Proces wordt afgebroken.")
End If
For i = 1 To CorrectWidth
Set SourceCell1 = Sheets(CStr(StartCell1.Offset(-j, i))).Range(LocalSSR).Find(SearchItem(j), lookat:=xlPart)
If SourceCell1 Is Nothing Then
MsgBox ("Kon " & SearchItem(j) & " niet vinden op werkblad " & Sheets(CStr(StartCell1.Offset(-j, i))).Name & ". Proces wordt afgebroken.")
Exit For
End If
Sheets(n).Range(StartCell1.Address).Offset(0, i).Value = Sheets(CStr(StartCell1.Offset(-j, i))).Range(SourceCell1.Address).Offset(0, StallIndex - 1).Value
Next i
Next j
Next StallIndex
End SubDe essentie van de macro is het verzamelen van alle benodigde gegevens, zoals aangegeven in de tabellen hierboven. Eerst gebruikte ik de 'SSR', een globaal zoekveld voor alle .find functies die ik gebruik, maar aangezien alle namen drie keer voorkomen is dat geen optie. Daarom gebruik ik de variabele 'CorrectRange' om het adres van de rij waarin het stalnummer staat te vinden en vervolgens het zoekgebied te vergroten tot CorrectHeight en CorrectWidth. Het probleem is echter dat dit niet werkt; LocalSSR geeft namelijk als waarde 'leeg' aan.
Heeft iemand hier misschien een oplossing voor?
