Datenübertrag in Datentabelle

WM-Tippspiel
Wir haben eine Eingabemaske, in welcher wir die Tipps erfassen möchten. Dann wäre die Idee, dass der Tipp, d.h. Name, Email, alle Resultate und die Rangierungstipps mittels Makro in die Datentabelle übernommen werden. Anschliessend können wir diese Daten in die Tipps Auswertung übernehmen, in welcher die Punkte anhand der definitiven Spielresultate ermittelt werden. Die Punkteauswertung funktioniert. Für den Übertrag aus der Eingabemaske habe ich mal ein Makro erstellt, welches aber seine Arbeit nur teilweise leistet. Etwas stimmt nicht. Aber ich als Leihe finde es nicht heraus... Und ich kann mir durchaus vorstellen, dass dies auch viel einfacher gehen könnte. Denn meine VBA-Kenntnisse sind sehr beschränkt... Vielleicht ist die Idee auch schlecht und man könnte es viel besser und einfacher lösen. Dagegen hätten wir auch absolut nichts einzuwenden. Manchmal sieht man vor lauter Bäumen den Wald nicht...;-)
Ich lade mal die Beispieldatei hoch, jemand kann mir sicher helfen. Erstens für den Übertrag in die Datentabelle. Diesen Zwischenschritt möchten wir einbauen, damit wir die Tipps in der Auswertung alphabetisieren können. Und vielleicht gibt es ja auch eine andere Variante für den Übertrag von Datentabelle in die Tipps Auswertung als =Daten!C$3, usw...
Datei: https://www.herber.de/bbs/user/155240.xlsm
Ziel wäre, dass wir nur in der Eingabemaske arbeiten und der Rest automatisiert vonstatten geht.
Jetzt schon mal vielen Dank, dass Ihr mein Problem anschaut.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

so der Herr, ich hoffe das passt so. Änderungen am Tabellenlayout wirken sich schädlich auf den Code aus.


Sub Daten_übertragen()
Dim oListObj As ListObject
Dim oListRow As ListRow
Dim ws As Worksheet
Dim i&, cnt&
Set ws = Worksheets("Eingabemaske")
With Worksheets("Daten")
Set oListObj = .ListObjects(1)
End With
Set oListRow = oListObj.ListRows.Add
With oListRow.Range
.Cells(1) = ws.Range("F3").Value
.Cells(2) = ws.Range("F4").Value
cnt = 3
For i = 8 To 55
.Cells(cnt).Value = ws.Cells(i, "H").Value
.Cells(cnt + 1).Value = ws.Cells(i, "J").Value
cnt = cnt + 2
Next
.Cells(cnt).Value = ws.Range("D61").Value
.Cells(cnt + 1).Value = ws.Range("D62").Value
.Cells(cnt + 2).Value = ws.Range("D63").Value
.Cells(cnt + 3).Value = ws.Range("D64").Value
End With
MsgBox "Übertrag erfolgreich!"
End Sub
Sub dateninAuswertung()
Dim i&, cnt&, lrow&, lcol, ofset&
Dim ws As Worksheet
Dim olstObj As ListObject
Dim olstRow As ListRow
Dim olstRows As ListRows
With Worksheets("Daten")
Set olstRows = .ListObjects(1).ListRows
End With
Set ws = Worksheets("Tipps Auswertung")
ofset = 5
lcol = 12
For Each olstRow In olstRows
With olstRow.Range
cnt = 3
ws.Cells(3, lcol).Value = .Cells(1).Value 'name
For i = 4 To 51
ws.Cells(i, lcol).Value = .Cells(cnt)
ws.Cells(i, lcol + 2).Value = .Cells(cnt + 1)
cnt = cnt + 2
Next
ws.Cells(55, lcol).Value = .Cells(cnt).Value
ws.Cells(56, lcol).Value = .Cells(cnt + 1).Value
ws.Cells(57, lcol).Value = .Cells(cnt + 2).Value
ws.Cells(58, lcol).Value = .Cells(cnt + 3).Value
End With
lcol = lcol + ofset
Next
End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread