Clever-Excel-Forum › Office-Anwendungen › Excel v
Excel vba Richtiges umkopieren

Thema geschlossen 
Baumstrukturmodus
Excel vba Richtiges umkopieren
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#11
01.03.2017, 11:24
(01.03.2017, 01:47)atilla schrieb: Hallo Erich,

das war blöd von mir.
Ich hatte den Code mit anderen Zellbzügen entwickelt und habe ihn nachträglich falsch auf Dein eingestelltes Beispiel angepasst.

Folgender Code sollte funktionieren:


Code:
Sub übertragen()
Dim i As Long, k As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld
Dim arr()

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
ReDim arr(lngA - 1)
For i = 1 To lngZ - 28
  If feld(i, 2) = "x" Then
    arr(k) = feld(i, 1)
    k = k + 1
  End If
Next i

If k > 0 Then
  Cells(27, lngS + 1).Resize(k) = Application.Transpose(arr)
End If

End If
 
End Sub



Hallo Attila,

jetzt funktioniert es schon etwas besser....aber es werden nicht alle Spieler berücksichtigt...schau mal......und es sollte der übertragene Spieler auch in der selben Zeile aufgeführt werden und nicht direkt untereinander.

Hast Du vielleicht noch ne Idee?


Aufstellungsvarianten
UVWXYZAAABACAD
26AuswahlR1R2R3R4R5
27Spieler 1xSpieler 1
28Spieler 2Spieler 3
29Spieler 3xSpieler 4
30Spieler 4xSpieler 6
31Spieler 5Spieler 7
32Spieler 6x
33Spieler 7x
34Spieler 8
35Spieler 9x
36Spieler 10x
Excel-Inn.de
Hajo-Excel.de
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 21.08 einschl. 64 Bit



Herzlichen Dank!
Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#12
01.03.2017, 11:44
Hallo Erich,

wnn Du die Zellen in die kopiert wird  so formatierst:

";;"

ginge es einfach mit folgendem Code:



Code:
Sub übertragen()
Dim i As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
For i = 1 To lngZ - 26
  If feld(i, 2) <> "x" Then
    feld(i, 1) = ""
  End If
Next i
 Range(Cells(27, lngS), Cells(lngZ, lngS)) = feld
End If

End Sub


In den leer ersichtlichen zellen würde dann eine nicht sichtbare 0 stehen.

So sähe es aus:

Arbeitsblatt mit dem Namen 'Tabelle1'
 UVWXYZ
26 Auswahl   R1
27Spieler 1x   Spieler 1
28Spieler 2x   Spieler 2
29Spieler 3     
30Spieler 4     
31Spieler 5     
32Spieler 6x   Spieler 6
33Spieler 7     
34Spieler 8x   Spieler 8
35Spieler 9     
36Spieler 10x   Spieler 10

ZelleFormatWert
Z27;;Spieler 1
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg


Sonst müsste der Code aufwendiger werden.
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • sharky51
Suchen
Top
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#13
01.03.2017, 12:01
(01.03.2017, 11:44)atilla schrieb: Hallo Erich,

wnn Du die Zellen in die kopiert wird  so formatierst:

";;"

ginge es einfach mit folgendem Code:



Code:
Sub übertragen()
Dim i As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
For i = 1 To lngZ - 26
  If feld(i, 2) <> "x" Then
    feld(i, 1) = ""
  End If
Next i
 Range(Cells(27, lngS), Cells(lngZ, lngS)) = feld
End If

End Sub


In den leer ersichtlichen zellen würde dann eine nicht sichtbare 0 stehen.

So sähe es aus:

Arbeitsblatt mit dem Namen 'Tabelle1'
 UVWXYZ
26 Auswahl   R1
27Spieler 1x   Spieler 1
28Spieler 2x   Spieler 2
29Spieler 3     
30Spieler 4     
31Spieler 5     
32Spieler 6x   Spieler 6
33Spieler 7     
34Spieler 8x   Spieler 8
35Spieler 9     
36Spieler 10x   Spieler 10

ZelleFormatWert
Z27;;Spieler 1
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg


Sonst müsste der Code aufwendiger werden.

Hallo Attila,
gut, aber jetzt werden die ausgewählten Spieler zwar in die richtige Zeile geschrieben aber in die falsche Anfangsspalte...in Spalte X und nicht in Spalte Z. Außerdem wird die Zielspalte immer überschrieben und nicht wir in Deiner vorhergehenden Version in die nächste Spalte z.B. AA geschrieben.

Kuckst Du ....


Aufstellungsvarianten
UVWXYZAAABACAD
26AuswahlR1R2R3R4R5
27Spieler 1xSpieler 1
28Spieler 2
29Spieler 3
30Spieler 4xSpieler 4
31Spieler 5
32Spieler 6xSpieler 6
33Spieler 7
34Spieler 8xSpieler 8
35Spieler 9xSpieler 9
36Spieler 10xSpieler 10
Excel-Inn.de
Hajo-Excel.de
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 21.08 einschl. 64 Bit



und nach Änderung der Auswahl....


Aufstellungsvarianten
UVWXYZAAABACAD
26AuswahlR1R2R3R4R5
27Spieler 1
28Spieler 2xSpieler 2
29Spieler 3
30Spieler 4xSpieler 4
31Spieler 5
32Spieler 6
33Spieler 7
34Spieler 8xSpieler 8
35Spieler 9
36Spieler 10xSpieler 10
Excel-Inn.de
Hajo-Excel.de
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 21.08 einschl. 64 Bit

Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#14
01.03.2017, 12:05
Hallo Erich,


schwere Geburt.

Änder diese Zeile so um:

Range(Cells(27, lngS + 1), Cells(lngZ, lngS + 1)) = feld

Das rot markierte ist hinzugekommen.
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • sharky51
Suchen
Top
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#15
01.03.2017, 13:10
(01.03.2017, 12:05)atilla schrieb: Hallo Erich,


schwere Geburt.

Änder diese Zeile so um:

Range(Cells(27, lngS + 1), Cells(lngZ, lngS + 1)) = feld

Das rot markierte ist hinzugekommen.

Hallo Attila,

danke....Asche auf mein Haupt...da hätte ich selbst drauf kommen können.
Aber das weiterschalten ab der Spalte Z ist damit noch nicht behoben.
Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#16
01.03.2017, 13:22
Hallo Erich,

müsste aber.

Da ich nicht genau weiß, welchen Code Du verändert hast, hier noch einmal der gesamte Code:


Code:
Sub übertragen()
Dim i As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
For i = 1 To lngZ - 26
  If feld(i, 2) <> "x" Then
    feld(i, 1) = 0
  End If
Next i
 Range(Cells(27, lngS + 1), Cells(lngZ, lngS + 1)) = feld
End If

End Sub



Und unten die Beispieldatei:


.xlsm   Mappe1Sharky51.xlsm (Größe: 17,65 KB / Downloads: 3)
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • sharky51
Suchen
Top
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#17
01.03.2017, 17:37
(01.03.2017, 13:22)atilla schrieb: Hallo Erich,

müsste aber.

Da ich nicht genau weiß, welchen Code Du verändert hast, hier noch einmal der gesamte Code:


Code:
Sub übertragen()
Dim i As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
For i = 1 To lngZ - 26
  If feld(i, 2) <> "x" Then
    feld(i, 1) = 0
  End If
Next i
 Range(Cells(27, lngS + 1), Cells(lngZ, lngS + 1)) = feld
End If

End Sub



Und unten die Beispieldatei:

Super Attila,

jetzt funktioniert es perfekt....vielen herzlichen Dank!
Suchen
Top
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#18
01.03.2017, 17:38
IHR SEID SCHON WIRKLICH ALLE KLASSE!!!!!!!!!!!
Suchen
Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#19
01.03.2017, 20:30
Hallo Erich,

du brauchst nicht in jeder Antwort den Beitrag vom Vorredner komplett zitieren. Die wissen meistens noch was sie vorher geschrieben haben. Blush
Gruß Stefan
Win 10 / Office 2016
Suchen
Top
sharky51 Offline
pausiert
ThreadStarter
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
#20
02.03.2017, 21:52
Hallo Attila,

ich muss nochmals nachhaken.
Deine Beispieldatei funktioniert bestens.
Nur hätte ich gerne die ganzen Daten an einer anderen Stelle im Tabellenblatt.
Leider schaffe ich es nicht das Ganze richtig anzupassen damit das an der Stelle (Zeilen/Spalten) auch funktioniert.

Wärst Du so nett mir den Code auf das eingefügte Tabellenblatt anzupassen...der Lerneffekt für mich wäre auch gleich da?


.xlsm   Mappe1Sharky51_V1.xlsm (Größe: 39,5 KB / Downloads: 2)
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste