Aufrufen einer Public Function über Sub verhindern
14.11.2017 15:38:07
Kim
ich kämpfe seit gefühlten 100 Jahren mit einer P ublic Function (die ich glaube ich auch hier gefunden hab) die durch ein Sub aufgerufen wird
und dann in Endlosschleife dort herumspringt - dadurch dauert das ganze unendlich.
Ich habe hier schon einen Eintrag gefunden dazu, allerdings leider ohne Lösung (kann auf die Function leider nicht verzichten)
Ich hätte nun gern eine Möglichkeit dass mein Makro normal durchläuft ohne die Function zu berühren.
Die Function ist folgende:
Public Function SVERWEIS2(Kriterium As String, Bereich As Range, SuchSpalte As Integer, _
ErgebnissSpalte As Integer, welcher_wert As Long)
'Original von UDO
Dim arrTmp
Dim arr()
Dim L As Long
Dim z
z = 1
arrTmp = Bereich
For L = 1 To UBound(arrTmp)
If arrTmp(L, SuchSpalte) = Kriterium Then
ReDim Preserve arr(z)
arr(z) = arrTmp(L, ErgebnissSpalte)
z = z + 1
End If
Next
SVERWEIS2 = arr(welcher_wert)
End Function
Mein Makro (in gekürzter Version weil sehr lang) ist das hier:
Sub Kopie()
Dim tbstr As String
Call Test
' fortlaufende Nummerierung
tbstr = "Bewertung " & ActiveWorkbook.Sheets.Count - 3
Application.ScreenUpdating = False
' Kopiert Original
Range("A1:J92").Select
Selection.Copy
' wo soll neues TB hin
Sheets.Add After:=Worksheets(Worksheets.Count)
' Paste inkl Formeln
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Blattschutz
ActiveSheet.Protect Password:="@Passwort", UserInterfaceOnly:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
'Name wie festgelegt
ActiveSheet.Name = tbstr
'Formatierung
Columns("A:J").EntireColumn.AutoFit
Rows("1:31").EntireRow.AutoFit
Application.CutCopyMode = False
Name = Cells(4, 3).Value
Var0 = Cells(3, 2).Value
Var1 = Cells(4, 2).Value
Sheets("Alle").Select
For I = 4 To 70
If Cells(I, 3).Value = "" Then
Cells(I, 1).Value = Name
Cells(I, 2).Value = Var0
Cells(I, 3).Value = Var1
Exit For
End If
Next
'Löscht alle Angaben damit eine neue Bewertung gemacht werden kann
Sheets("Analyse").Select
Range("C6:C14").ClearContents
Range("C16:C17").ClearContents
Range("C19:C22").ClearContents
Range("I6:I19").ClearContents
Range("E6:E25").ClearContents
Range("J6:J19").ClearContents
Range("B3").ClearContents
Range("H3").ClearContents
Application.ScreenUpdating = True
Sheets("Analyse").Select
Range("B3").Select
End Sub Kann mir vl jemand helfen und sagen was ich tun kann damit die Function nicht aufgerufen wird?
Vielen Dank im Voraus!