539 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo,

ich bin ziemlicher Laie, habe aber bereits angefangen.
Ich möchte Mitglieder (mit Name, Vorname, IBAN, Kontonummer und BLZ) per Button in eine zweite Tabelle aneinanderreihen

Zunächst einmal habe ich zwei Buttons (Einzelnes Mitglied hinzufügen & Alle Mitglieder hinzufügen). Bei dem einzelnen Mitglied öffnet sich eine Userform.
Hier der Tabelle1-Code:

Private Sub AlleMitglieder_Click()
Modul1.one_long = 0
Modul1.Daten_pruefen
End Sub

Private Sub EinMitglied_Click()
Modul1.one_long = 0
UserForm1.Show
End Sub


one_long benutze ich als reset-Wert, aber dazu später mehr.

Ich habe einige Teile kopiert, weil ich VBA nicht so gut kenne.
Userform-Code:

Private Sub Abbrechen_Click()
Unload Me
End Sub

Private Sub Speichern_Click()
For i = 2 To Tabelle1.UsedRange.Rows.Count
If Tabelle1.Cells(i, 1) = ComboBox1.List(ComboBox1.ListIndex) Then Modul1.one_long = i

Next i

Unload Me

Modul1.Daten_pruefen
End Sub

Private Sub UserForm_Initialize()

For i = 1 To Tabelle1.UsedRange.Rows.Count - 1
ComboBox1.AddItem
ComboBox1.List(i - 1) = Tabelle1.Cells(i + 1, 1)
Next i

With ComboBox1
again:
For i = 0 To .ListCount - 2
If .List(i + 1) < .List(i) _
Then
tmp = .List(i)
.List(i) = .List(i + 1)
.List(i + 1) = tmp
GoTo again
End If
Next i

.ListIndex = 0
End With
End Sub


Bei Speichern wird one_long auf i gesetzt, damit später auch nur das i-te Miglied hinzugefügt wird.
Dann kommt bei mir ein Sub Daten_pruefen...dort prüft der aber nur, ob die einzelnen Zellen einen Wert haben, wenn nicht läuft der erst gar nicht weiter.

Dann kommt der fehlerhafte Sub Daten_uebertragen.
Ich versuche da dann entweder i oder halt alle Mitglieder bis Tabelle1.UsedRange.Rows.Count hinzuzufügen, deswegen auch:

If one_long > 0 Then
start = one_long
ende = one_long
Else
start = 2
ende = Tabelle1.UsedRange.Rows.Count
End If


Wenn es den Vor- und Nachnamen dann also in der zweiten Tabelle noch nirgends gibt, soll er die ganze Zeile des Mitglieds i kopieren.
So circa nur dass Range falsch verwendet wurde:

Sub Daten_uebertragen()
Dim Range As Long
Dim a As Range

Range = Tabelle2.UsedRange.Rows.Count + 1
Set a = Range("A2:A100", 1)

For row = start To ende
For col = 1 To Tabelle1.UsedRange.Columns.Count
If Tabelle2.Range(a) = Tabelle1.Range(a) _
Then
MsgBox "Den Namen in Zeile " & row & " gibt es bereits" & vbCrLf & vbCrLf & _
"Bitte ändern/ löschen Sie den Namen"
End If
If Tabelle2.Cells(row, 2) <> Tabelle1.Cells(row, 2) And Tabelle2.Cells(row, 1) <> Tabelle1.Cells(row, 1) _
Then
MsgBox "Fügt " & Tabelle1.Cells(row, 2) & " " & Tabelle1.Cells(row, 1) & " hinzu."
Tabelle2.Cells(Range, col) = Tabelle1.Cells(row, col)
End If

Next col

Next row


End Sub


Nur leider kommt die MsgBox natürlich bei jeden Durchgang.
Ich hoffe das ist relativ verständlich, kenne halt nur ein paar Befehle.

7 Antworten

0 Punkte
Beantwortet von
Ach ja und wenn man alle Mitglieder hinzufügen möchte ist one_long = 0, demnach wird start = 2 und ende die letzte beschriebene Zeile in Tabelle 1. Dann soll der halt Daten_uebertragen() mit allen vollen Zeilen durchführen und nicht nur mit i
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

geht es hier um Excel? Und erkläre doch bitte mal kurz den Aufbau der Datei (z.B. in welchen Spalten Name und Vorname stehen).

Gruß

M.O.
0 Punkte
Beantwortet von
Tabelle1:

A B C D E

Button_EinMiglied Button_AlleMitglieder

1 Name Vorname IBAN Kontonummer BLZ
2 Mustermann Max DE... XXXXXX XXXXXX
3
4
etc.


Tabelle2:


A B C D E

1 Name Vorname IBAN Kontonummer BLZ
2
3
4
5
etc.


In Tabelle2 sollen die Mitglieder dann eingefügt werden, wenn die Bedingungen stimmen.[/code][/code]
0 Punkte
Beantwortet von
Und ja, es ist Excel VBA

Gruß
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

ich bin leider erst jetzt dazu gekommen, dir etwas zu basteln.
Hier mal eine Beispieldatei.

In der Datei gibt es nur einen Button für das Auswählen. Im Dropdown-Menü kannst du zwischen alle Mitglieder und den einzelnen Mitgliedern auswählen.

Hier die Codes, die in ein Standard Modul deiner betreffenden Arbeitsmappe gehören:

Global arrData As Variant

Sub start()

Dim Tausch As Variant
Dim lngLetzte As Long

With Worksheets("Tabelle1")
'letzte Zeile festlegen
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
'und alle Daten einlesen
arrData = .Range(Cells(2, 1), Cells(lngLetzte, 5))

End With

'Sortieren
For Z = UBound(arrData) - 1 To LBound(arrData) Step -1
For i = LBound(arrData) To Z
If LCase(arrData(i, 1)) > LCase(arrData(i + 1, 1)) Then
For t = 1 To 5
Tausch = arrData(i, t)
arrData(i, t) = arrData(i + 1, t)
arrData(i + 1, t) = Tausch
Next t
End If
Next i
Next Z

UserForm1.ComboBox1.AddItem "alle Mitglieder"

For Z = 1 To UBound(arrData)
UserForm1.ComboBox1.AddItem arrData(Z, 1) & ", " & arrData(Z, 2)
Next Z

UserForm1.ComboBox1.ListIndex = 0

UserForm1.Show


End Sub


Sub uebertragen()

Dim lngLetzte As Long
Dim lngAnfang As Long
Dim lngEnde As Long
Dim arrZiel As Variant
Dim i As Long
Dim j As Long
Dim m As Long
Dim bVorhanden As Boolean
Dim wksZiel As Worksheet


'Zieltabelle definieren
Set wksZiel = ThisWorkbook.Worksheets("Tabelle2")

'Anfangs- und Endzeile für einzufügende Mitglieder festlegen
If UserForm1.ComboBox1.ListIndex = 0 Then
'alle
lngAnfang = 1
lngEnde = UBound(arrData, 1)
Else
'nur ausgewählten
lngAnfang = UserForm1.ComboBox1.ListIndex
lngEnde = UserForm1.ComboBox1.ListIndex
End If

'Zielliste einlesen
With wksZiel
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile in Zieltabelle ermitteln
arrZiel = .Range(.Cells(2, 1), .Cells(lngLetzte, 5))
End With

Unload UserForm1

For i = lngAnfang To lngEnde
bVorhanden = False
For j = 1 To UBound(arrZiel, 1)
If arrData(i, 1) = arrZiel(j, 1) Then
If arrData(i, 2) = arrZiel(j, 2) Then bVorhanden = True 'Falls es Satz mit Namen und Vornamen schon in Zieltabelle gibt, dann Schalter auf wahr setzen
End If
Next j

If bVorhanden = True Then
'falls zu übertragendes Mitglied bereits vorhanden ist, dann Meldung ausgeben
MsgBox "Das Mitglied " & arrData(i, 2) & " " & arrData(i, 1) & " ist in Zieltabelle bereits vorhanden!", 64, "Info"
Else
'sonst Daten übertragen
lngLetzte = lngLetzte + 1 'Einfügezeile um 1 erhöhen
'Daten anfügen
For m = 1 To 5
With wksZiel
.Cells(lngLetzte, m) = arrData(i, m)
End With
Next m
End If

Next i

'Abschlussmeldung
MsgBox "Die Übertragung der ausgewählten Mitglieder ist beendet", 64, "Info"

wksZiel.Activate

End Sub


Rufe mit dem Button im Tabellenblatt das Makro start auf.
Mit dem Button in deiner Userform zu übertragen, rufe das Makro uebertragen auf.

Gruß

M.O.
0 Punkte
Beantwortet von
Hier mal eine Beispieldatei.


Perfekt !!
Ich versuche den Code ´mal auf eine Mitgliederliste ohne Makros anzuwenden sonst benutze ich einfach deine mit copy&paste der Mitglieder.

Ja viele Befehle kannte ich einfach nicht deswegen so kompliziert, aber hätte nicht mit einer komplett fertigen Lösung gerechnet, danke nochmals!

Gruß
ein glücklicher Azubi
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

vielen Dank für die Rückmeldung. Freut mich, dass das Makro so funktioniert, wie du dir das vorstellst.

Gruß

M.O.
...