AW: VBA-Code / Combobox
02.02.2012 11:22:09
fcs
Hallo Thomas,
die Verwendung von verbundenen Zellen in den Spalten-Überschriften macht das ganze unnötig kompliziert, da die Autofilter-Funktionen nicht nutzbar ist, d.h., es muss jede Zeile einzeln ausgewertet werden.
Nachfolgend der komplette Code für das Userform, wie ich ihn in etwa aufbauen würde.
Gruß
Franz
Option Explicit
Private lngZeileKopie As Long
Private wksData As Worksheet
Private wksZiel As Worksheet
Private Sub Abbrechen_Click()
wksData.Rows.Hidden = False
Unload Me
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Doppelklick ins Userform zeigt alle Zeilen in Katalog wieder an
wksData.Rows.Hidden = False
Cancel = True
End Sub
Private Sub UserForm_Initialize()
'Combox wird über VBA mit Inhalt gefüllt
cbfach.RowSource = "HT!D2:D10"
cbSemester.RowSource = "HT!G1:G22"
Set wksData = Worksheets("Katalog")
Set wksZiel = Worksheets("Tabelle2")
With wksZiel
If Not IsEmpty(.Cells(1, 1)) Then
If MsgBox("Vorhandene Daten in Zieltabelle löschen?", vbQuestion + vbYesNo, _
"Katalogdaten kopieren") = vbYes Then
.UsedRange.ClearContents
lngZeileKopie = 1
Else
lngZeileKopie = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
Else
lngZeileKopie = 1
End If
End With
End Sub
Private Sub export_Click()
Dim lngZeile As Long, lngSpalte As Long, strWSSS, varJahr
strWSSS = Left(Me.cbSemester, 2)
varJahr = Mid(Me.cbSemester, 4)
varJahr = Val(varJahr)
With wksData
.Rows.Hidden = False
For lngSpalte = 10 To .Cells(9, .Columns.Count).End(xlToLeft).Column
If .Cells(9, lngSpalte).Value = varJahr And .Cells(8, lngSpalte).Value = strWSSS Then
For lngZeile = 10 To IIf(IsEmpty(.Cells(Rows.Count, 1)), _
.Cells(Rows.Count, 1).End(xlUp).Row, .Rows.Count)
If .Cells(lngZeile, 1) = Me.cbfach And _
UCase(.Cells(lngZeile, lngSpalte).Value) = "X" Then
.Range(.Cells(lngZeile, 4), .Cells(lngZeile, 5)).Copy _
Destination:=wksZiel.Cells(lngZeileKopie, 1)
wksZiel.Cells(lngZeileKopie, 3).Value = Me.cbfach.Value
wksZiel.Cells(lngZeileKopie, 4).Value = Me.cbSemester.Value
lngZeileKopie = lngZeileKopie + 1
Else
.Rows(lngZeile).Hidden = True
End If
Next lngZeile
' wksZiel.Activate
Exit For
End If
Next lngSpalte
End With
End Sub