Daten 1 in Daten 2

[michel34497]

Hallo Stefan!

Hier mal ein Tabellen ausschnitt von mir wie es aus sieht.
Normal müsste hinter jeden Namen ein wert stehen.


Startblatt

	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
3	Name	Anwesend	Entschuldigt	Unenschuldigt	KEGELSPIELE
4	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15
5	SILKE	1			0,5	0,5	0,5
6	ANDREA	1
7	ELKE	1
8	MICHAEL	1			0,8	0,8	0,8
9	EBI	1
10	UTE	1
11	IRIS	1
12	GABY	1
13	????	2
14	GÄSTE
15
16	Heinz	1			0,9	0,9	0,9
17
18
19
20

verbundene Zellen

B3:B4

C3:C4

D3: D4

E3:E4

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 17.21 einschl. 64 Bit

Ich weiß nicht warum er das so macht. Im Tabellenblatt Spiele stehen alle Namen und er trägt nur wie im ausschnitt zu sehen ein.
Ich hoffe es hilft weiter!

[Steffl]

Hallo Michael,

es könnte daran legen, dass die Namen im Tabellenblatt Spiele anders geschrieben sind als im Tabellenblatt Spiele. Da reicht ein angehängtes Leerzeichen was man ja nicht sieht oder das da steht "Teilnehmer: MICHAEL". Ich habe trotzdem den Code nochmals ergänzt und jetzt wird dir angezeigt, wenn es einen Namen nicht gibt. Es werden hier immer die Namen aus dem Tabellenblatt Spiele geprüft.

Code:

Sub prcUebernahme()
   Dim lngLetzteZeile As Long, lngC As Long
   Dim rngName As Range, rngGefuellt As Range
  
   With Worksheets("Spiele")
      lngLetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
      Set rngGefuellt = Worksheets("Startblatt").Range("F5:T22").Find(What:="*", lookat:=xlWhole, LookIn:=xlValues, _
      searchorder:=xlByColumns, SearchDirection:=xlPrevious)
      For lngC = 9 To lngLetzteZeile
         Set rngName = Worksheets("Startblatt").Columns(2).Find(.Cells(lngC, 1), lookat:=xlWhole, LookIn:=xlValues, searchorder:=xlByRows)
         If Not rngName Is Nothing Then
            If Not rngGefuellt Is Nothing Then
            If rngGefuellt.Column = 20 Then MsgBox "Alle Spalten sind gefüllt!", vbInformation: Exit For
               Worksheets("Startblatt").Cells(rngName.Row, rngGefuellt.Column + 1).Value = .Cells(lngC, 13).Value
'               rngName.Offset(, 19).Value = .Cells(lngC, 12).Value
'               rngName.Offset(, 21).Value = .Cells(lngC, 9).Value
            Else
               Worksheets("Startblatt").Cells(rngName.Row, 6).Value = .Cells(lngC, 13).Value
'               rngName.Offset(, 19).Value = .Cells(lngC, 12).Value
'               rngName.Offset(, 21).Value = .Cells(lngC, 9).Value
            End If
         End If
      Next lngC
   End With
   Set rngName = Nothing
   Set rngGefuellt = Nothing
End Sub

[michel34497]

Hallo Stefan!
Nach dem ich den Code getestet habe, konnte ich es nicht glauben. Genau das selbe was ich gesendet habe und eine Meldung kam auch nicht bei dem neuen Code. Weil ich das nicht glauben kann das bei dir alles geht und bei mir NICHT, habe ich folgendes gemacht:

Tabellenblatt Startblatt geöffnet
VBA geöffnet und ganz nach unten gezogen das ich das Startblatt wieder sehe und den Code Starten mit F5 Starten kann.
Was ich dann gesehen habe wirst du mir wahrscheinlich nicht glauben.
Die WERTE aus Spiele werden in das Startblatt übertragen, das sehe ich auch.
Doch nun der Hammer: Sind sie übertragen werden einige werte wieder gelöscht so wie ich den Tabellen ausschnit gepostet habe.
Ich sehe das alles wenn ich den Code Starte. Wie kann so was möglich sein ???????????????
Hast du oder ein anderer eine Ärklärung dafür!
Es ist doch genau die gleich Datei!

[Steffl]

Hallo Michael,

Tabellenblatt Startblatt geöffnet
VBA geöffnet und ganz nach unten gezogen das ich das Startblatt wieder sehe und den Code Starten mit F5 Starten kann.
Was ich dann gesehen habe wirst du mir wahrscheinlich nicht glauben.
Die WERTE aus Spiele werden in das Startblatt übertragen, das sehe ich auch.
Doch nun der Hammer: Sind sie übertragen werden einige werte wieder gelöscht so wie ich den Tabellen ausschnit gepostet habe.
Ich sehe das alles wenn ich den Code Starte. Wie kann so was möglich sein ???????????????
Hast du oder ein anderer eine Ärklärung dafür!
Es ist doch genau die gleich Datei!

Verwende mal anstatt der F5-Taste die F8-Taste. Hier arbeitet Excel im Einzelschrittmodus und Du mußt weiterhin mit der F8-Taste durch den Code gehen damit Du siehst wie der Code abgearbeitet wird, denn ich vermute, das hier irgendein Ereignismakro mit hineinspielt und die Werte löscht.

[michel34497]

Hallo Stefan!
Danke für den Tipp! Ich habe es gefunden!

Im Tabellenblatt Spiele ist ab Zeile 70 ein anderse Spiel und dort stehen die Namen anders.
Wie kann man das begrenzen das der Code vieleicht nur bis zu den letzten eingetragenen Namen reagiert der bei diesen Spiel ist?
Wenn dieser Code Funktioniert will ich ihn so umbasteln das er auch das gleich für das nächste spiel macht.

[Steffl]

Hallo Michael,

vielleicht im Tabellenblatt Spiele den Bereich mit der Zeile 70 und folgende löschen wenn Du sie nicht brauchst. Und was meinst Du mit den nächsten Spiel?

Gruß Stefan

[michel34497]

Hallo Stefan!

Leider werden diese Zeilen ab 70 auch gebraucht. Dort steht das nächste Spiel drin was wir machen.
Was ich mit dem nächsten Spiel meine ist dieses was ab Zeile 70 steht.
Kann mann den Code nicht begrenzen beim auslesen der Namen?

[Steffl]

Hallo Michael,

da würde ich für dieses Spiel halt eine andere Tabelle nehmen aber na ja das mußt letzendlich Du wissen. Habe es geändert und auch kommentiert.

Code:

Sub prcUebernahme()
   Dim lngLetzteZeile As Long, lngC As Long
   Dim rngName As Range, rngGefuellt As Range
  
   With Worksheets("Spiele")
      lngLetzteZeile = .Cells(69, 1).End(xlUp).Row 'von .Rows.Count auf 69 geändert :-(
      Set rngGefuellt = Worksheets("Startblatt").Range("F5:T22").Find(What:="*", lookat:=xlWhole, LookIn:=xlValues, _
      searchorder:=xlByColumns, SearchDirection:=xlPrevious)
      For lngC = 9 To lngLetzteZeile
         Set rngName = Worksheets("Startblatt").Columns(2).Find(.Cells(lngC, 1), lookat:=xlWhole, LookIn:=xlValues, searchorder:=xlByRows)
         If Not rngName Is Nothing Then
            If Not rngGefuellt Is Nothing Then
            If rngGefuellt.Column = 20 Then MsgBox "Alle Spalten sind gefüllt!", vbInformation: Exit For
               Worksheets("Startblatt").Cells(rngName.Row, rngGefuellt.Column + 1).Value = .Cells(lngC, 13).Value
'               rngName.Offset(, 19).Value = .Cells(lngC, 12).Value
'               rngName.Offset(, 21).Value = .Cells(lngC, 9).Value
            Else
               Worksheets("Startblatt").Cells(rngName.Row, 6).Value = .Cells(lngC, 13).Value
'               rngName.Offset(, 19).Value = .Cells(lngC, 12).Value
'               rngName.Offset(, 21).Value = .Cells(lngC, 9).Value
            End If
         End If
      Next lngC
   End With
   Set rngName = Nothing
   Set rngGefuellt = Nothing
End Sub

[michel34497]

Hallo Stefan!
Vielen Dank!
Doch jetzt weiter irgendwie müssen die Pumpen, Strafen, alle Neune und Kranz auch noch übertragen werden.
Erst einmal Pumpen und Strafen.
Da ja eine Formel in der Zellen für Pumpen und Strafen steht und die auf das Tabellenblatt Daten zugreift ist es möglich die Formel zu manipulieren oder sollte besser die Namen auch im Tabellenblatt Daten stehen?

[Steffl]

Hallo Michael,

wie von Dir gewünscht, habe ich nur Eintragungen bei den Pumpen und Strafen gemacht. Hier habe ich die Formelzelle hergenommen, auf die Zelladresse verkürzt und danach in das Datenblatt Daten den Wert in die richtige Zeile eingetragen. Ob ich jetzt mit meiner Addition richtig liege, weiß ich nicht. Mußt Du halt dementsprechend abändern, aber das sollte ja kein Problem sein. Einfach den Teil nachdem istgleich-Zeichen bis zum Additionszeichen entfernen.

Code:

Sub prcUebernahme()
   Dim lngLetzteZeile As Long, lngC As Long
   Dim rngName As Range, rngGefuellt As Range
   Dim strZelle As String
  
   With Worksheets("Spiele")
      lngLetzteZeile = .Cells(69, 1).End(xlUp).Row 'von .Rows.Count auf 69 geändert :-(
      Set rngGefuellt = Worksheets("Startblatt").Range("F5:T22").Find(What:="*", lookat:=xlWhole, LookIn:=xlValues, _
      searchorder:=xlByColumns, SearchDirection:=xlPrevious)
      For lngC = 9 To lngLetzteZeile
         Set rngName = Worksheets("Startblatt").Columns(2).Find(.Cells(lngC, 1), lookat:=xlWhole, LookIn:=xlValues, searchorder:=xlByRows)
         If Not rngName Is Nothing Then
            If Not rngGefuellt Is Nothing Then
               If rngGefuellt.Column = 20 Then MsgBox "Alle Spalten sind gefüllt!", vbInformation: Exit For
               Worksheets("Startblatt").Cells(rngName.Row, rngGefuellt.Column + 1).Value = .Cells(lngC, 13).Value
            Else
               Worksheets("Startblatt").Cells(rngName.Row, 6).Value = .Cells(lngC, 13).Value
            End If
            strZelle = Mid(Worksheets("Startblatt").Cells(rngName.Row, 21).FormulaLocal, 13, _
            InStr(3, Worksheets("Startblatt").Cells(rngName.Row, 21).FormulaLocal, ">") - 13)
            Worksheets("Daten").Range(strZelle).Value = Worksheets("Daten").Range(strZelle).Value + .Cells(lngC, 12).Value
            Worksheets("Daten").Range(strZelle).Offset(, 1).Value = Worksheets("Daten").Range(strZelle).Offset(, 1).Value + .Cells(lngC, 9).Value
         End If
      Next lngC
   End With
   Set rngName = Nothing
   Set rngGefuellt = Nothing
End Sub