Makro wird nur zur Hälfte ausgeführt
18.08.2017 08:57:22
Dennis
ein weiteres Problem mit einem Makro in meiner Suchmaske(UF) hat sich ergeben.
Ich habe mit Excel 2010 in der VBA Umgebung eine Userform gebaut, welche 3 Tabellen auf 3 unterschiedlichen Arbeitsblättern auslesen soll. Die Ausgabe findet in 10 TextBoxen bzw. 9 und eine Combobox statt. Danach sollen die Werte geändert werden können und in die Tabelle an gleicher Stelle überschrieben werden. Das Umbuchen von Einträgen "auf Lager" zu "in Benutzung" o.Ä soll auch möglich sein. Dabei wird allerdings in der Prozedur der Eintrag in der "alten" Tabelle nicht entfernt, sodass sich der umzubuchende Eintrag dupliziert und in beiden Tabellen auftaucht.
Hier einmal das Listing:
Private Sub umbuchen_Click()
Dim lZeile As Long
Dim c As Range
Dim wsvon, wszu As String
Dim Suchwert As String
Dim Zeile
' Abfrage welche Von-Option ausgewählt ist
If benutzung.Value = True Then
wsvon = "in Benutzung"
ElseIf leihgabe.Value = True Then
wsvon = "in Leihgabe"
ElseIf lager.Value = True Then
wsvon = "auf Lager"
End If
' Abfrage welche Zu-Option ausgewählt ist
If um_benutzung.Value = True Then
wszu = "in Benutzung"
ElseIf um_leihgabe.Value = True Then
wszu = "in Leihgabe"
ElseIf um_lager.Value = True Then
wszu = "auf Lager"
End If
If wszu "" And wsvon "" Then
Suchwert = invitem.Value
lZeile = Sheets(wszu).Range("A65536").End(xlUp).Row
Worksheets(wszu).Range("A" & lZeile).Value = invitem.Text
Worksheets(wszu).Range("B" & lZeile).Value = device.Text
Worksheets(wszu).Range("C" & lZeile).Value = model.Text
Worksheets(wszu).Range("D" & lZeile).Value = telefonnummer.Text
Worksheets(wszu).Range("E" & lZeile).Value = leasinganfang.Text
Worksheets(wszu).Range("F" & lZeile).Value = leasingende.Text
Worksheets(wszu).Range("G" & lZeile).Value = building.Text
Worksheets(wszu).Range("H" & lZeile).Value = room.Text
Worksheets(wszu).Range("I" & lZeile).Value = bemerkung.Text
Worksheets(wszu).Range("J" & lZeile).Value = namevorname.Text
Worksheets(wszu).Range("K" & lZeile).Value = siglum.Text
'***Eintrag wird nicht aus der Tabelle "wsvon" entfernt, sondern dupliziert***
For Zeile = 1 To Range("A65536").End(xlUp).Row
If Worksheets(wsvon).Cells(Zeile, 1).Value = Suchwert Then
Worksheets(wsvon).Cells(Zeile, 1).Value = ""
invitem.Text = ""
Worksheets(wsvon).Cells(Zeile, 2).Value = ""
device.Text = ""
Worksheets(wsvon).Cells(Zeile, 3).Value = ""
model.Text = ""
Worksheets(wsvon).Cells(Zeile, 4).Value = ""
telefonnummer.Text = ""
Worksheets(wsvon).Cells(Zeile, 5).Value = ""
leasinganfang.Text = ""
Worksheets(wsvon).Cells(Zeile, 6).Value = ""
leasingende.Text = ""
Worksheets(wsvon).Cells(Zeile, 7).Value = ""
building.Text = ""
Worksheets(wsvon).Cells(Zeile, 8).Value = ""
room.Text = ""
Worksheets(wsvon).Cells(Zeile, 9).Value = ""
bemerkung.Text = ""
Worksheets(wsvon).Cells(Zeile, 10).Value = ""
namevorname.Text = ""
Worksheets(wsvon).Cells(Zeile, 11).Value = ""
siglum.Text = ""
End If
Next Zeile
Else: MsgBox "Momentaner Bestand und/oder Zielbestand wurde nicht ausgewählt!"
Exit Sub
End If
'*******Sortieren A-Z von wsvon*******************************
If wsvon = "in Benutzung" Then
t1 = "Tabelle1"
ElseIf wsvon = "in Leihgabe" Then
t1 = "Tabelle2"
ElseIf wsvon = "auf Lager" Then
t1 = "Tabelle3"
End If
ActiveWorkbook.Worksheets(wsvon).ListObjects(t1).Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets(wsvon).ListObjects(t1).Sort. _
SortFields.Add Key:=Range("Tabelle1[[#All],[Anlagennummer]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(wsvon).ListObjects(t1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'*******Sortieren A-Z von wszu*******************************
If wszu = "in Benutzung" Then
t2 = "Tabelle1"
ElseIf wszu = "in Leihgabe" Then
t2 = "Tabelle2"
ElseIf wszu = "auf Lager" Then
t2 = "Tabelle3"
End If
ActiveWorkbook.Worksheets(wszu).ListObjects(t2).Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets(wszu).ListObjects(t2).Sort. _
SortFields.Add Key:=Range("Tabelle1[[#All],[Anlagennummer]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(wszu).ListObjects(t2).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
VG Dennis