Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Code erweitern

Betrifft: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 13:18:18

Hallo Leute ,

kann mir jemand helfen diesen Code um einen Befehl zu erweitern?

Ich möchte erreichen das wenn die leeren Zeilen gelöscht werden, der jeweils
letzte Eintrag aus zelle J3 nach J2 kopiert wird und das für alle folgenden.

Also wenn Zelle a3 = leer dann zeile löschen aber vorher J3 nach J2 kopieren.

weis net wie ichs machen soll!

Danke schonmal

  

Betrifft: AW: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 13:19:51

https://www.herber.de/bbs/user/54698.xls

hier die Bsp. Mappe


  

Betrifft: AW: Code erweitern von: hary
Geschrieben am: 18.08.2008 14:07:53

Hallo Sockel
Versuch mal diesen Code im Button. Der Bereich muss noch angepasst werden.


For i = 1 To 17
         If IsEmpty(Cells(i, 1)) Then
             Cells(i - 1, 10).Value = Cells(i, 10)
                Rows(i).Select
    Selection.Delete Shift:=xlUp
         End If    
     Next i


Gruss Hary


  

Betrifft: AW: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 14:33:03

Harry,
vielen dank das klappt sehr gut.

Wenn es jetzt noch eine möglichkeit gibt
es so anzupassen das dies auch mit folgender Mappe möglich ist! ( dein code ist schon eingefügt, müßte jetzt noch zurechtgreückt werden.)

Also immer so das der letzte eintrag aus J nach oben kopiert wird.

Wenn wir das hinkriegen schmeiß ich ne runde virtuelles Bier :-)
Danke

https://www.herber.de/bbs/user/54700.xls




  

Betrifft: AW: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 14:54:32

hab mal ausprobiert, also es geht schon und zwar so:

Habe den Code

For i = 1 To 19
If IsEmpty(Cells(i, 1)) Then
Cells(i - 1, 10).Value = Cells(i, 10)
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i

Einfach dreimal hintereinander eingefügt.
Aber ist das auch sicher ?


  

Betrifft: AW: Code erweitern von: hary
Geschrieben am: 18.08.2008 15:21:09

Hallo sockel
So aehnlich habe ich es auch. Nur mit Anzahl. Einzig die letzte belegte Zelle(J19) wird nicht angezeigt.Deshalb Frage offen.
Dim anzahl As Long

Private Sub CommandButton1_Click()
For anzahl = 1 To 5 ' Anzahl der wiederholungen
For i = 1 To 19
         If IsEmpty(Cells(i, 1)) Then
             Cells(i - 1, 10).Value = Cells(i, 10)
                Rows(i).Select
    Selection.Delete Shift:=xlUp
         End If
     Next i
     Next anzahl
End Sub




  

Betrifft: AW: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 15:43:50

Erstmal danke Harry,

Mal so als Idee : vor dem eigentlichen code die letzte befüllte zelle ermitteln, in diesem Fall J19 und J19 zu J20
kopieren - dann den code.

Bsp. muss angepasst werden, aber wie?

Dim lRow As Long

With ActiveSheet
lRow = Cells(Rows.Count, 1).End(xlUp).Row
End With
End Sub

Bis Dann

sockel 939


  

Betrifft: AW: Code erweitern von: sockel939
Geschrieben am: 18.08.2008 15:56:08

Hallo Harry,

Damit kann man die letzte befüllte Zelle einen nach unten kopieren, funzt aber nicht richtig mit dem anderen code zusammen, nur mit eigenem button!

Sub LetzteZelleKopieren() 
   Sheets("Tabelle1").Range("G65000").End(xlUp).Copy Destination:=Sheets("Tabelle2").Range("B1") _
 
End 

Sub 

sockel939



  

Betrifft: AW: habmal hilfe zur hilfe aufgerufen von: hary
Geschrieben am: 18.08.2008 17:03:33

Hallo Sockel
hab mal bei Rudi nachgefragt ob er helfen wuerde.
Hary


  

Betrifft: AW: habmal hilfe zur hilfe aufgerufen von: Tino
Geschrieben am: 18.08.2008 21:23:05

Hallo,
entschuldige dass ich mich einmische, teste mal diesen Code

Sub löschen()
Dim A As Long
Application.ScreenUpdating = False
For A = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
 If Cells(A, "A") = "" Then
  Cells(A, "J").Copy Cells(A - 1, "J")
  Rows(A).Delete
 End If
Next A
Application.ScreenUpdating = True
End Sub



In deinem Beispiel ist nur die Frage was ist mit der Zeile 16?



Gruß Tino


  

Betrifft: AW: habmal hilfe zur hilfe aufgerufen von: sockel939
Geschrieben am: 19.08.2008 08:55:21

Danke Toni der klappt auch!


 

Beiträge aus den Excel-Beispielen zum Thema "Code erweitern"