| 

.NET C# Java Javascript Exception

2
Hi zusammen,

ich hab folgende zwei Codes. Ich habe ein Tabellenblatt "PLZ" in der habe ich in der Spalte A über mehrere Zeilen Postleitzahlen eines bestimmten Umkreises um eine andere PLZ.

Im zweiten Tabellenblatt habe ich potentielle Kundendaten, die für eine Softwarevorführung in Frage kommen. Über das Script will ich alle Kunden aus der Kundenliste raus löschen, die nicht im Umkreis um PLZ X (also nicht in der Tabelle "PLZ") vorkommen.

An der Stelle "MsgBox VarToBeFound" bekomm ich noch ganz korrekt ein Popup mit einer Postleitzahl. Das hab ich nur zum testen eingebaut, das Popup fliegt natürlich raus.

IsInArray = (UBound(Filter(arr, VarToBeFound)) > -1)

In dieser Zeile bekomme ich dann immer die Fehlermeldung "Typen unverträglich" - aber ich hab schon so viel Google gewühlt und verschiedene Typen ausprobiert, dass ich ziemlich am Ende meines Lateins bin. Habt ihr einen Tipp für mich?


Option Explicit

Sub ZeileLöschen()
Dim rngZelle As Range
Dim rngList As Range
Dim varArr1()

Set rngList = ThisWorkbook.Worksheets("wmslizenzen").Range("D2:D131")
varArr1() = ThisWorkbook.Worksheets("PLZ").Range("A1:A387").Value

For Each rngZelle In rngList
If IsInArray(rngZelle.Value, varArr1) = False Then rngZelle.EntireRow.Delete
Next rngZelle

Set rngZelle = Nothing
End Sub


Public Function IsInArray(VarToBeFound As Variant, arr As Variant) As Boolean
MsgBox VarToBeFound
IsInArray = (UBound(Filter(arr, VarToBeFound)) > -1)
End Function


Im Idealfall bekommen wir es vielleicht sogar noch so hin, dass das For each rückwärts läuft der Array umgekehrt wird? :)
News:
20.01.2015
Ibiz 21 1 3
2 Antworten
1
Filter erwartet ein String- oder Object-Array und einen String. So müsste es eigentlich funktionieren:
Public Function IsInArray(VarToBeFound As String, arr() As String) As Boolean

Aber ohne Gewähr, ich kann das hier nicht testen.

Umgekehrt über das Array zu iterieren wird nicht gehen, aber du kannst den Inhalt des Arrays in umgekehrter Reihenfolge in ein anderes Array kopieren
20.01.2015
phg 1,6k 4
1
Jetzt will ich doch auch mal was zurück geben:
So funktioniert das Script und tut genau das was ich will :-)

Sub CellDelete()
Dim Zeile
Dim Spalte
Dim iRange As Range
Dim xRange As Range
Application.EnableEvents = True
ActiveSheet.Unprotect Password:=" "
Spalte = ActiveCell.Column
Zeile = ActiveCell.Row
Set xRange = Range(Cells(Zeile, Spalte), Cells(Zeile + 1, Spalte))
For Each iRange In xRange
If iRange.MergeCells Then
iRange.UnMerge
End If
Next
If DebugActive Then MsgBox ("Zellen " & Range(Cells(Zeile, Spalte), Cells(Zeile + 1, Spalte)).AddressLocal(False, False) & " gelöscht.")
Range(Cells(Zeile, Spalte), Cells(Zeile + 1, Spalte)).ClearContents
Range(Cells(Zeile, Spalte), Cells(Zeile + 1, Spalte)).Merge
ActiveSheet.Protect Password:=" ", UserInterfaceOnly:=True, AllowFormattingCells:=True
End Sub


Function IsInArray(ByVal VarToBeFound As Variant, ByVal Arr As Variant) As Boolean
Dim Element As Variant
For Each Element In Arr
If Element = VarToBeFound Then
IsInArray = True
Exit Function
End If
Next Element
End Function


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim RegExpression As Object
Dim ErrorMessage As VbMsgBoxResult
Application.EnableEvents = False
If DebugActive Then MsgBox ("Es wurde ein Eintrag verändert. " & Target.Address & " Prüfung gestartet!")
If Not Sh.Name = "Urlaubsplanung" And Not Sh.Name = "Konfiguration" And Not Sh.Name = "Auswertung" Then
Select Case Target.Column
Case 3, 4, 7
Application.StatusBar = "Tabelle " & Sh.Name & " | Zeile " & Target.Row & " | Spalte " & Target.Column
'If Not Target.Cells.Value = "" And
If Target.Cells.Count = 1 And Not IsEmpty(Target) And Target.NumberFormat <> "hh:mm" Then
'Formatierungsregeln definieren
Set RegExpression = CreateObject("VBScript.RegExp")
RegExpression.Pattern = "^([01][0-9]|2[0-3]):[0-5][0-9]$"
'Formatierung auf Gültigkeit prüfen
If Not RegExpression.Test(Trim(Target.Cells(1, 1).Text)) Then
'Im Fehlerfall bearbeitete Zelle markieren, Fehlermeldung ausgeben und Zellinhalt löschen
Target.Cells(1, 1).Activate
ErrorMessage = MsgBox("Geben Sie die Uhrzeit im Format [hh:mm] ein." & vbNewLine & "Die Uhrzeit muss zwischen 00:00 Uhr und 23:59 Uhr liegen.", _
vbOKOnly + vbExclamation, "Keine gültige Uhrzeit eingegeben!")
If DebugActive Then MsgBox ("Zelle " & Target.Column & " geändert." & vbNewLine & "Ungültige Uhrzeit!")
Call CellDelete.CellDelete
Else
Call BerechneArbeitszeit
If DebugActive Then MsgBox ("Zelle " & Target.Column & " geändert. Uhrzeit ist korrekt." & vbNewLine & "Berechnung durchgeführt!")
End If
Else
Call BerechneArbeitszeit
If DebugActive Then MsgBox ("Zelle " & Target.Column & " geändert. Eintrag ist leer." & vbNewLine & "Neuberechnung durchgeführt!")
End If
Case 5
Call BerechneArbeitszeit
If DebugActive Then MsgBox ("Zelle " & Target.Column & " geändert." & vbNewLine & "Berechnung nach Tätigkeit durchgeführt!")
End Select
End If
Application.EnableEvents = True
End Sub
30.01.2015
Ibiz 21 1 3

Stelle deine Array-Frage jetzt!
TOP TECHNOLOGIES CONSULTING GmbH