Fout : type komen niet overeen

Status
Niet open voor verdere reacties.

AnoukMannaerts

Gebruiker
Lid geworden
15 mei 2014
Berichten
19
Bij de volgende code krijg ik een foutmelding (gemarkeerd)
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
 
Even snel gekeken. Het zal niet de oorzaak van het probleem zijn maar gebruikt eerste een inspringpunten op de juiste posities om de leesbaarheid te vergroten. Zoals nu is het maar lastig te volgen welke stukken bij elkaar horen. Gebruik ook geen Goto en labels: in een loop maar het Continue statement.
 
Sorry, ik haalde even een paar talen door elkaar. Maar hier is wat ik bedoel:

Code:
Public Sub FindText()
    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
            If .Name <> "AfkortingenLeerkrachten" And .Name <> "AantalUrenPerLeerkracht" Then
                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
                    UlCel = ActiveCell.Offset(0, -1).Value
                    BreukCel = ActiveCell.Offset(0, -2).Value
                    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)
                Loop While Not Found Is Nothing And Found.Address <> FirstAddress
            End If
        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

Het zal niet de oplossing van je probleem zijn maar zo is de boel een stuk leesbaarder en is de GoTo eruit.
Let ook op je ActiveCell. Als die in kolom A staat gaat ActiveCell.Offset(0, -1).Value fout.
Hetzelfde geldt voor ActiveCell.Offset(0, -2).Value uiteraard.

Daarnaast is het beter om geen compleet Engelse woorden als naam van variabelen te gebruiken. Dit kan conflicten veroorzaken met interne variabelen. Maak van Found als Range bijvoordeeld rFound.
 
Laatst bewerkt:
Dan gaat deze op slot
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan