AnoukMannaerts
Gebruiker
- Lid geworden
- 15 mei 2014
- Berichten
- 19
Bij de volgende code krijg ik een foutmelding (gemarkeerd)
Weet iemand wat ik fout doet?
Weet iemand wat ik fout doet?
Code:
Public Sub FindText()
'Run from standard module, like: Module1.
'Find all data on all sheets!
'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
'lijst met ul en breuk
Dim arraylijstUl(29, 29) As Single
Dim arraylijstBreuk(29, 29) As Single
'range om ul eruit te halen
Dim UlCel As Integer
Dim BreukCel As Integer
myText = InputBox("Enter text to find")
If myText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet4!
If ws.Name = "AfkortingenLeerkrachten" Then GoTo myNext
If ws.Name = "AantalUrenPerLeerkracht" Then GoTo myNext
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
' uitlezen van UL en breuk
[B][COLOR="#FFFF00"]
UlCel = ActiveCell.Offset(0, -1).Value
BreukCel = ActiveCell.Offset(0, -2).Value[/COLOR][/B]
arraylijstUl(1, foundNum) = UlCel
arraylijstBreuk(1, foundNum) = BreukCel
AddressStr = AddressStr & .Name & " " & Found.Address & " " & UlCel & " " & arraylijstUl(1, foundNum) & " " & arraylijstBreuk(1, foundNum) & vbCrLf
Set Found = .UsedRange.FindNext(Found)
'Copy found data row to sheet4 Option!
'Found.EntireRow.Copy _
'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
myNext:
End With
Next ws
If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub