AW: Überschrift finden - Spalte kopieren
25.11.2007 18:30:00
Erich
Hallo Wolfgang,
wäre es anstelle eines Fehlerhandlings beim Kopieren nicht sinnvoller,
die Vorgabe ungültiger Überschriften zu unterbinden? Eine Gültigkeitsprüfung gibt es ja schon.
Aber sie wirkt nicht richtig. Zitat aus der Excel-Hilfe zu "Festlegen gültiger Zelleinträge": _
p>
Anmerkung Wenn die von Ihnen zugelassenen Werte auf einem Zellbereich mit definiertem Namen
basieren und sich im Bereich eine leere Zelle befindet, führt die Aktivierung des
Kontrollkästchens Leere Zellen ignorieren dazu, dass beliebige Werte in die Zelle
eingegeben werden können, die auf Gültigkeit geprüft wird.
Dies gilt auch für Zellen, auf die durch Formeln zur Gültigkeitsprüfung bezug genommen wird:
Wenn eine der Zellen leer ist, auf die bezug genommen wird, führt die Aktivierung des
Kontrollkästchens Leere Zellen ignorieren dazu, dass beliebige Werte in die Zelle eingegeben
werden können, die auf Gültigkeit geprüft wird.
Lösung:
Du schränkst die Liste für die Gültigkeit ein auf die Spalten A bis S, also =Filter!$A$1:$S$1
(T1 ist leer und verursacht die Nicht-Prüfung der Eingabe.)
Alternativ ginge natürlich auch die Fehlerbehandlung in der Routine:
Sub StrassenlisteKopieren()
Dim intC As Integer, ii, lngZ As Long
Sheets("Liste").Select
' Application.ScreenUpdating = False
With Sheets("Filter")
For intC = 1 To 7
If Not IsEmpty(Cells(1, intC)) Then
On Error Resume Next
ii = Application.WorksheetFunction.Match(Cells(1, intC), [Überschrift], 0)
On Error GoTo 0
If ii > 0 Then
lngZ = .Cells(.Rows.Count, ii).End(xlUp).Row
.Range(.Cells(2, ii), .Cells(lngZ, ii)).Copy Cells(2, intC)
Range(Cells(lngZ + 1, intC), Cells(Rows.Count, intC)).Clear
Else
MsgBox "Ungültige Überschrift '" & Cells(1, intC) & _
"' in Zelle " & Cells(1, intC).Address(0, 0)
End If
End If
Next intC
End With
Columns("A:G").AutoFit
' Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort