Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem beim Übertrag UF Textbox in gefilterte Tab

Problem beim Übertrag UF Textbox in gefilterte Tab
21.05.2017 13:32:42
Peter
Hallo ihr Excelspezialisten,
in diesem Forum habe ich Codes gefunden, mit welchen ich in Tabelle1 Filter setze.
Den gefilterten Bereich kopiere ich in die Tabelle2.
Mittels Listbox werden bestimmte Daten geändert.
Nun möchte ich die geänderten Daten wieder in die Tabelle1 übertragen.
Problem ist jedoch, dass die Zeilen-Nummern von Tabelle2 nicht mit der in Tabelle1
übereinstimmen.
Oder gibt es eine Möglichkeit - die Tabelle1 zu filtern und nur der gefiltete Bereich wird in Listbox1 angezeigt und bearbeitet(es sind 11 Spalten - Daten einlesen erfolgt mit Rowsource).
Besten Dank für eure Hilfe.
nachstehend mein Code:
Private Sub CommandButton6_Click()
With Range("Tabelle2!A1:K122")
Me.Tag = "1"
.Cells(ListBox1.ListIndex + 1, 4).Value = TextBox4
.Cells(ListBox1.ListIndex + 1, 7).Value = TextBox7
.Cells(ListBox1.ListIndex + 1, 8).Value = TextBox8
.Cells(ListBox1.ListIndex + 1, 9).Value = TextBox9
.Cells(ListBox1.ListIndex + 1, 10).Value = TextBox10
.Cells(ListBox1.ListIndex + 1, 11).Value = TextBox11
Me.Tag = ""
End With
End Sub

Private Sub ListBox1_Click()
If Me.Tag = "1" Then Exit Sub
With ListBox1
UserForm1.TextBox1 = .List(.ListIndex, 0)
UserForm1.TextBox2 = .List(.ListIndex, 1)
UserForm1.TextBox3 = .List(.ListIndex, 2)
UserForm1.TextBox4 = .List(.ListIndex, 3)
UserForm1.TextBox5 = .List(.ListIndex, 4)
UserForm1.TextBox6 = .List(.ListIndex, 5)
UserForm1.TextBox7 = .List(.ListIndex, 6)
UserForm1.TextBox8 = .List(.ListIndex, 7)
UserForm1.TextBox9 = .List(.ListIndex, 8)
UserForm1.TextBox10 = .List(.ListIndex, 9)
UserForm1.TextBox11 = .List(.ListIndex, 10)
End With
End Sub

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Sheets("Tabelle1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$K$191").AutoFilter Field:=4, Criteria1:="0"
If Worksheets("Tabelle2").Range("A1") = "" Then
Call AF_Kopieren
Sheets("Tabelle1").Select
Selection.AutoFilter
Sheets("Tabelle2").Select
With ListBox1
.ColumnCount = 11
.ColumnWidths = "3,5cm;3,5cm;2,5cm;3cm;3,5cm;3,5cm;2,5cm;3cm;3,5cm;3cm;3,5cm"
.ColumnHeads = False
With Sheets("Tabelle2")
ListBox1.RowSource = "Tabelle2!A1:N500"
End With
End With
Else
Sheets("Tabelle2").Select
With ListBox1
.ColumnCount = 11
.ColumnHeads = False
With Sheets("Tabelle2")
ListBox1.RowSource = "Tabelle2!A1:N500"
End With
End With
End If
Application.ScreenUpdating = True
End Sub
Gruss
Peter

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem beim Übertrag UF Textbox in gefilterte Tab
22.05.2017 10:35:36
ChrisL
Hi Peter

Die Datei https://www.herber.de/bbs/user/113723.xlsm wurde aus Datenschutzgründen gelöscht


Private Sub CommandButton6_Click()
Dim ar As Variant, i As Integer
ar = Array(4, 7, 8, 9, 10, 11)
With Worksheets("Tabelle1")
For i = 0 To UBound(ar)
.Cells(ListBox1.List(ListBox1.ListIndex, 11), ar(i)) = Controls("TextBox" & ar(i))
ListBox1.List(ListBox1.ListIndex, ar(i) - 1) = Controls("TextBox" & ar(i))
Next i
End With
End Sub

Private Sub ListBox1_Click()
Dim i As Integer
CommandButton6.Enabled = True
For i = 0 To 10
Controls("TextBox" & i + 1) = ListBox1.List(ListBox1.ListIndex, i)
Next i
End Sub

Private Sub UserForm_Initialize()
Dim iZeile As Long, i As Integer
Dim iCounter As Long: iCounter = 0
With Worksheets("Tabelle1")
For iZeile = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(iZeile, 4) = 0 Then
If iCounter = 0 Then
ReDim ar(11, iCounter)
Else
ReDim Preserve ar(11, iCounter)
End If
For i = 0 To 10
ar(i, iCounter) = .Cells(iZeile, i + 1)
Next i
ar(11, iCounter) = iZeile
iCounter = iCounter + 1
End If
Next iZeile
ListBox1.List = Application.Transpose(ar)
End With
End Sub

cu
Chris
Anzeige
AW: Problem beseitigt
22.05.2017 11:38:56
Peter
Hallo Chris,
das ist Super - genau das was ich gesucht habe.
Vielen herzlichen Dank.
Wünsche Dir noch einen schönen Tag.
Gruss
Peter
noch einen Zusatz zu diesem Thema
22.05.2017 15:21:00
Peter
Hallo Chris,
wie schon ausgeführt funktioniert das Ganze einwandfrei. Eine ideale Lösung.
Jetzt habe ich noch ein zusätzliches Problem:
Wenn die Daten der Listbox abgearbeitet sind, möchte ich die Werte der Spalten 2 und 4 = B und D kopieren und in eine andere Tabelle einfügen. Falls die nicht möglich sein sollte die gesamte ListBox in eine andere Tabelle einfügen.
Besten Dank für Deine Hilfe.
Gruss
Peter
AW: noch einen Zusatz zu diesem Thema
22.05.2017 16:41:13
ChrisL
Hi Peter
so?

Worksheets("Tabelle1").Columns(2).Copy Worksheets("Tabelle2").Range("A1")
Worksheets("Tabelle1").Columns(4).Copy Worksheets("Tabelle2").Range("B1")
cu
Chris
Anzeige
AW: noch einen Zusatz zu diesem Thema
22.05.2017 17:06:24
Peter
Hallo Chris,
danke für Deine Antwort aber da haben wir uns missverstanden.
Es geht darum, dass ich die Zeilen in der von Dir erstellten Listbox auswähle(Multiselect) und dann die Daten in eine separate Tabelle einfüge.
Funktioniert mit dem nachstehenden Code einwandfrei:
Private Sub CommandButton7_Click()
Dim wks As Worksheet
Dim rng As Range
Dim iCounter As Integer
Set wks = ActiveSheet
'   Workbooks.Add
Worksheets.Add After:=Sheets(Sheets.Count)
Set rng = ActiveSheet.Range("A1")
'   Set rng = Worksheets("Tabelle4").Range("A1")
For iCounter = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iCounter) Then
wks.Rows(iCounter + 1).Copy rng
Set rng = rng.Offset(1, 0)
End If
Next iCounter
Call SpalteCuE_kop_einfügen
End Sub
Sub SpalteCuE_kop_einfügen()
Dim lLetzte As Long
Sheets(Sheets.Count).Select 'aktiviert das letzte Tabellenblatt
lLetzte = ActiveSheet.Range("C65536").End(xlUp).Row
ActiveSheet.Range("C2:C" & lLetzte).Copy
Worksheets("Tabelle3").Select
Cells(Cells.Rows.Count, 1).End(xlUp).Select
ActiveSheet.Paste
Sheets(Sheets.Count).Select 'aktiviert das letzte Tabellenblatt
lLetzte = ActiveSheet.Range("E65536").End(xlUp).Row
ActiveSheet.Range("E2:E" & lLetzte).Copy
Worksheets("Tabelle3").Select
Cells(Cells.Rows.Count, 2).End(xlUp).Select
ActiveSheet.Paste
Sheets(Sheets.Count).Delete 'aktiviert das letzte Tabellenblatt
End Sub Da dies etwas umständlich ist, wollte ich wissen, ob Du als Excel-Fuchs eine einfachere Lösung
kennst.
Wenn ich die Userform aufrufe und sich die ListBox1 füllt - soll der Bereich mit Vornamen und passenden Geschlecht kopiert und am Ende von z.B. Tabelle2 eingefügt werden.
Vielleicht geht das so irgendwie.
Denn jetzt muss ich eine Listbox für das Abarbeiten der Spalte Geschlecht verwenden und eine andere mit Multiselect für das kopieren. Ausserdem muss ich noch etwas finden, was die Zeilen markiert.
Besten Dank im voraus.
Gruss
Peter
Anzeige
AW: noch einen Zusatz zu diesem Thema
22.05.2017 17:45:16
Peter
Hallo Chris,
ich habe da mal was zusammengebastelt. Funktioniert aber noch nicht so wie ich das gerne hätte.
Private Sub UserForm_Initialize()
Dim iZeile As Long, i As Integer
Dim iCounter As Long: iCounter = 0
With Worksheets("Tabelle2")
For iZeile = 1 To .Cells(Rows.Count, 5).End(xlUp).Row
If .Cells(iZeile, 5) = 0 Then
If iCounter = 0 Then
ReDim ar(12, iCounter)
Else
ReDim Preserve ar(12, iCounter)
End If
For i = 0 To 11
ar(i, iCounter) = .Cells(iZeile, i + 1)
Next i
ar(12, iCounter) = iZeile
iCounter = iCounter + 1
End If
Next iZeile
With ListBox1
.List = Application.Transpose(ar)
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
For iNr = 1 To 12
.Selected(iNr - 1) = True
Next iNr
End With
End With
End Sub

1. Problem es werden in der ListBox1 nur die erste Spalte angezeigt.
2. in der Zeile For iNr = 1 To 12 hätte ich gerne, dass alle Zeilen angezeigt werden,
in denen in Spalte A ein Wert enthalten ist.
Ich hoffe das Ganze ist verständlich und bereitet Dir nicht all zu viel Mühe.
Gruss
Peter
Anzeige
AW: noch einen Zusatz zu diesem Thema
22.05.2017 18:12:01
ChrisL
Hi Peter
Normalerweise erstellt der Fragende die Beispieldateien und nicht der Antworter. Frage 1 kann ich mittels Ferndiagnose nicht beantworten.
Frage 2: Die Bedingung ergänzen
If .Cells(iZeile,1)  "" And .Cells(iZeile, 5) = 0 Then
MultiSelect ergibt keinen Sinn, weil damit nicht mehr klar ist, welcher Datensatz in den TextBoxen bearbeitet wird. Entsprechend funktioniert dann auch der Übertrag zurück in die Tabelle nicht mehr.
cu
Chris
AW: noch einen Zusatz zu diesem Thema
23.05.2017 07:49:37
Peter
Hallo Chris,
besten Dank für Deine Bemühungen.
Leider führt mich das nicht weiter. Ich lasse es jetzt bei meiner bisherigen Version.
Wünsche Dir einen schönen Tag.
Gruss
Peter
Anzeige
AW: noch einen Zusatz zu diesem Thema
23.05.2017 13:45:22
Peter
Hallo Chris,
ich bräuchte nochmals dringend Deine Hilfe.
Deine Musterdatei geändert anbei.
Wenn über Tabelle1 Button "UserForm1 öffnen" die UF geöffnet wird, werden die Daten mit 0 in Spalte D(4) mittels Button Übertrag übernommen.
Anschliessend drücke ich Button ListBox als Multi umwandeln - markiere dann einzeln die vorhandenen
Zeilen.
Und hier ist das Problem: Kann dies so gesteuert werden, dass per Button alle Zeilen markiert werden in denen in Spalte A Wert und in Spalte D grösser 0 vorhanden ist.
Und da Du bereits einen Blick auf die Sache wirfst bitte ich noch zu prüfen, ob anstatt dem Button
Daten in Tabelle 3 übertragen es möglich ist, dass die Werte der Spalte A und D direkt in die Tabelle 3 eingetragen werden kann.
Musterdatei anbei:

Die Datei https://www.herber.de/bbs/user/113746.xlsm wurde aus Datenschutzgründen gelöscht


Besten Dank dass Du nochmals die Sache ansiehst.
Gruss Peter
Anzeige
bin raus...
23.05.2017 16:30:29
ChrisL
Hi Peter
Sorry, aber ich bin hier raus. Weil a) ich verstehe nicht was du willst und b) ändern sich die Anforderungen.
Einmal Spalte D, dann änderst du auf Spalte E, jetzt wieder D. Dann schreibst du von A und D, im Makro ist dann aber C und E. Tabelle1 zu Tabelle3 übertragen oder Listbox zu Tabelle3, mit oder ohne Bedingungen. Bedingungen beim Laden der Listbox oder erst beim Übertrag und noch irgendwelche Datensätze selektieren.
Einfach nur Chaos und das Wetter ist zu schön...
cu
Chris
AW: vielleicht doch noch?!
23.05.2017 16:42:01
Peter
Hallo Chris,
da ist mir wohl ein Fehler unterlaufen.
In der Testdatei sind es Spalten A und D.
In meiner Orginaldatei sind es die Spalten A und E.
Der Programmablauf ist, wie Du es richtig gemacht hast, dass ich in Listbox1 die Daten aufrufe.
Dann werden die Zeilen einzeln aufgerufen und in TextBox5 die Daten entweder w oder m eingetragen
und mittels Button Übertrag übernommen.
Wenn alle Zeilen abgearbeitet sind, drücke ich den Button Listbox als Multi umwandeln - dann markiere ich alle Zeilen mit Haken - und drücke zum Schluss den Button Daten in Tabelle 3 übertragen.
Das einzige was mir wichtig wäre, dass beim Drücken des Button Listbox als Multi umwandeln - alle Zeilen markiert werden, welche in Listbox in Spalte A einen Wert haben und in Spalte D grösser als 0.
Wünsche Dir bei dem schönen Wetter noch einen schönen Tag.
Vielleich geht ja doch noch was.
Gruss
Peter
Anzeige
eine letzte Gratisprogrammierung
24.05.2017 10:26:34
ChrisL
Hi Peter
Viel Arbeit...
https://www.herber.de/bbs/user/113765.xlsm
Option Explicit
Public b As Boolean
Private Sub CommandButton10_Click()
Dim i As Long, letzteZeile As Long
With Worksheets("Tabelle3")
letzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
letzteZeile = letzteZeile + 1
.Cells(letzteZeile, 1) = ListBox1.List(i, 2)
.Cells(letzteZeile, 2) = ListBox1.List(i, 4)
End If
Next i
End With
End Sub

Private Sub Uebertrag()
Dim ar As Variant, i As Integer
ar = Array(4, 7, 8, 9, 10, 11)
With Worksheets("Tabelle1")
For i = 0 To UBound(ar)
.Cells(ListBox1.List(ListBox1.ListIndex, 11), ar(i)) = Controls("TextBox" & ar(i)). _
Value
ListBox1.List(ListBox1.ListIndex, ar(i) - 1) = Controls("TextBox" & ar(i))
Next i
End With
End Sub

Private Sub CommandButton7_Click()
Unload Me
End Sub

Private Sub ListBox1_Click()
Dim i As Integer
b = True
If ListBox1.ListIndex >= 0 And ListBox1.MultiSelect = fmMultiSelectSingle Then Call TBaktiv
For i = 0 To 10
Controls("TextBox" & i + 1) = ListBox1.List(ListBox1.ListIndex, i)
Next i
b = False
End Sub

Private Sub TextBox10_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub TextBox11_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub TextBox4_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub TextBox7_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub TextBox8_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub TextBox9_Change()
If Not b Then Call Uebertrag
End Sub

Private Sub ToggleButton1_Change()
Dim i As Long
Call TBinaktiv
If Not ToggleButton1 Then
With ListBox1
.MultiSelect = fmMultiSelectSingle
.ListStyle = fmListStylePlain
End With
CommandButton10.Enabled = False
Else
With ListBox1
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
For i = 0 To .ListCount - 1
If .List(i, 0)  "" Then .Selected(i) = True
Next i
End With
CommandButton10.Enabled = True
End If
End Sub

Private Sub UserForm_Initialize()
Dim iZeile As Long, i As Integer
Dim iCounter As Long: iCounter = 0
For i = 1 To 11
Me.Controls("TextBox" & i).BackColor = RGB(211, 211, 211)
Next i
With Worksheets("Tabelle1")
For iZeile = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(iZeile, 4) = 0 Then
If iCounter = 0 Then
ReDim ar(11, iCounter)
Else
ReDim Preserve ar(11, iCounter)
End If
For i = 0 To 10
ar(i, iCounter) = .Cells(iZeile, i + 1)
Next i
ar(11, iCounter) = iZeile
iCounter = iCounter + 1
End If
Next iZeile
ListBox1.List = Application.Transpose(ar)
End With
End Sub

Private Sub TBaktiv()
Dim ar As Variant, i As Integer
ar = Array(4, 7, 8, 9, 10, 11)
For i = 0 To UBound(ar)
With Controls("TextBox" & ar(i))
.Enabled = True
.BackColor = RGB(255, 255, 255)
End With
Next i
End Sub

Private Sub TBinaktiv()
Dim ar As Variant, i As Integer
ar = Array(4, 7, 8, 9, 10, 11)
For i = 0 To UBound(ar)
With Controls("TextBox" & ar(i))
.Enabled = False
.BackColor = RGB(211, 211, 211)
End With
Next i
End Sub

cu
Chris
Anzeige
AW: eine letzte Gratisprogrammierung
24.05.2017 13:23:01
Peter
Hallo Chris,
vielen, vielen Dank, das ist wunderbar.
Jetzt ist genau das vorhanden, was ich benötige.
Ich wünsche Dir einen schönen Tag.
Der erste Test ist fantastisch, mal sehen, ob ich in der Form Deiner Programierung durchblicke.
Gruss
Peter

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige