Beim klick, felder ausfüllen VBA Excel

M

mafioso

Mitglied
Hallo,

wenn ich ein leeres Feld auswähle bzw. eine zeile runtergehe und diese Zeile komplett leer ist will ich, dass er die Vorherige Zeile von Spalte A bis Spalte V runterzieht, also nicht kopiert sondern runterzieht. Das wichtigste ist das er das macht wenn ich z.b. auf ein bestimmtes Feld komme, z.b. Feld C5 wobei das in jeder Zeile die Spalte C sein soll. Wie kann ich das in VBA ermöglichen.

Danke

mafioso
 
Weiß keiner die Antwort? Wie geht das? brauch nur einen kleinen Befehl der erkennt ob ein feld ausgewählt ist und dann automatisch text einfügt, den Rest kan ich mir selber zusammenbasteln.
 
Also, ich komm mit z.b. pfeiltasten oder durch eingabetaste auf eine leere zeile (komplett leer) also wenn die leer ist soll der die vorherige zeile runterschieben, in der vorherigen zeile ist dann eine formel. Dies soll dazu dienen das man jedesmall wenn man auf eine leere zeile kommt, das er automatisch die formel da einfügt ohne auf makro zu drücken.

Am anfang ist eine excel tabele mit 2 zeilen ausgefüllt, wenn man was neues eintragen will, soll es genügen auf eine leere zeile zu gehen, in dieser leeren zeile wird dann z.b. von Spalte B bis T automatisch eine formel eingefügt. Soweit verstanden?
 
Hi...

Also wenn ich dich nun Richtig verstanden habe müsste das deine Lösung sein...

  1. Öffne die Excel-Datei in der du die Funktion haben willst.
  2. Öffne den VBA Editor -> Extras/Macro/VisualBasic-Editor
  3. Doppelklick auf die Tabelle in der du die Funktion haben willst
  4. Füge folgenden Code ein
Visual Basic: 
Private DropWS_SelChange As Boolean     'Wenn auf True wird "Worksheet_SelectionChange" nicht _
                                         bearbeitet. Die Sub wird bei jeder änderung die _
                                         dann durchgeführt wird ausgeführt. Daher wärend _
                                         der bearbeitung neuen Sub Aufruf Abbrechen...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ErrHandle     'WICHTIG: Bei Fehler Sub Verlassen...
    Dim tRow As Long            'Aktuelle Zeile
    Dim CheckCol As String      'Zu prüfende Spalte
    Dim CopyColFrom As String   'Spalte von...
    Dim CopyColTo As String     '... bis bearbeiten
    
    If DropWS_SelChange = True Then Exit Sub    'Siehe "Private DropWS_SelChange..."
    
    CheckCol = "A"      'Spalte A prüfen
    CopyColFrom = "A"   'Von Spalte A...
    CopyColTo = "F"     'bis Spalte F bearbeiten
    
    tRow = Target.Row   'Aktuelle Zeile zwischenspeichern
    If Target.Value = "" And tRow > 1 Then  'Weiter wenn Zelle Leer ist und sich min. in der 2ten Zeile befindet
        If Not Range(CheckCol & tRow - 1).Value = "" Then   'Weiter Wenn Zelle oberhalb in der Spalte CheckCol nicht Leer ist
            DropWS_SelChange = True 'Festlegen das diese sub nicht mehr aufgerufen werden darf
            Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow - 1).Select   'Bereich makieren
            Selection.AutoFill Destination:=Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow), Type:=xlFillDefault 'Bereich eines runter ziehen...
            Range(CopyColFrom & tRow).Select    'Zelle in der Spalte CopyColFrom und der aktuellen Zeile auswählen
            DropWS_SelChange = False    'Sub wieder Freigeben...
        End If
    End If
ErrHandle:  'Sprungmarke die aufgerufen wird wenn ein Fehler auftritt...
End Sub

Nun musst du nur noch ein paar dinge anpassen...
CheckCol= Spalte der Zeile in der der zu Prüfende Wert ist (Leer)
CopyColFrom= Ab inkl. dieser Spalte bis...
CopyColTo= ...zu dieser Spalte die Werte oberhalb des Feldes herunter ziehen

Fertig...

Sag bescheid obs bei dir auch Funktioniert so wie bei mir...

lg Tody
 
Jo danke, t bei mir auch, problem ist das ich auf anderen zeilen nichts schreiben kann, ich will das er da einfügt ich aber andere zeilen ausfüllen kann, aber das versuch ich morgen selber auf der arbeit zu erledigen, wenn ich nicht weiterkomme sag ich bescheid. Danke viel mals.

mafioso
 
Hi...

Wenn ich richtig verstanden hab hast jetzt das Problem das er immer bei einer Leeren Zeile die Routine ausführt... oder?

Änder den Code folgend ab... Fett geschriebene Zeilen sind verändert oder neu!
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ErrHandle     'WICHTIG: Bei Fehler Sub Verlassen...
    Dim tRow As Long            'Aktuelle Zeile
    Dim CheckCol As String      'Zu prüfende Spalte
    Dim CheckValue As String   'Zu prüfender Wert
    Dim CopyColFrom As String   'Spalte von...
    Dim CopyColTo As String     '... bis bearbeiten
    
    If DropWS_SelChange = True Then Exit Sub    'Siehe "Private DropWS_SelChange..."
    
    CheckCol = "E"          'Spalte E prüfen
    CheckValue = "AutoFill" 'Bei diesem Wert Zeile anfügen
    CopyColFrom = "A"       'Von Spalte A...
    CopyColTo = "E"         'bis Spalte E bearbeiten
    
    tRow = Target.Row   'Aktuelle Zeile zwischenspeichern
    If Target.Value = "" And tRow > 1 And Range(CheckCol & tRow).Value = "" Then 'Weiter wenn Zelle Leer ist und sich min. in der 2ten Zeile befindet und CheckCol in dieser Zeile noch Leer ist
        If Range(CheckCol & tRow - 1).Value = CheckValue Then   'Weiter Wenn Zelle oberhalb in der Spalte CheckCol den Wert CheckValue hat
            DropWS_SelChange = True 'Festlegen das diese sub nicht mehr aufgerufen werden darf
            Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow - 1).Select   'Bereich makieren
            Selection.AutoFill Destination:=Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow), Type:=xlFillDefault 'Bereich eines runter ziehen...
            Range(CopyColFrom & tRow).Select    'Zelle in der Spalte CopyColFrom und der aktuellen Zeile auswählen
              
            'Eventuelle Felder die leer sein sollen...
            Range("B" & tRow).Value = ""
            Range("C" & tRow).Value = ""              
  
            DropWS_SelChange = False    'Sub wieder Freigeben...
        End If
    End If
ErrHandle:  'Sprungmarke die aufgerufen wird wenn ein Fehler auftritt...
End Sub
Somit wird die Zeile nur angefügt wenn vorherige Bedingungen erfüllt sind.
Und zusätzlich noch in der Spalte E eine Zeile höher "AutoFill" steht.
Weiters muss in der Zeile die Spalte E Leer sein.
Somit kannst du den Text in den Zellen auch bearbeiten...

Ausserdem leere ich die Felder der Spalte B und C da dort Text eingegeben werden soll.
Beim Rest wird die Formel Kopiert...

Auszug aus der Excel-Tabelle...
AutoFill.jpg

CheckCol = "E"
CheckValue ="AutoFill"
CopyColFrom ="A"
CopyColTo = "E"

Spalte A: Vortlaufende Nummer
Spalte B/C: Bezeichnung und Preis
Spalte D: Vortlaufende Summe
Spalte E: CheckCol mit Wert "AutoFill". Textfarbe auf weis somit nicht gleich sichtbar
Könnte mann auch ganz zusammen schieben...

lg Tody
 
Jo funktioniert alles perfekt, damit es nach meinen Vorstellungen verläuft hab ich den Quelltext minimal Verändert.

In der Spalte G bis M stehen die Werte die Kopiert werden sollen,
Von spalte A bis spalte F soll man seine Daten reinschreiben können (Name etc.)

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ErrHandle     'WICHTIG: Bei Fehler Sub Verlassen...
    Dim tRow As Long            'Aktuelle Zeile
    Dim CheckCol As String      'Zu prüfende Spalte
    Dim CheckValue As String   'Zu prüfender Wert
    Dim CopyColFrom As String   'Spalte von...
    Dim CopyColTo As String     '... bis bearbeiten

    If DropWS_SelChange = True Then Exit Sub    'Siehe "Private DropWS_SelChange..."

    CheckCol = "G"        'Spalte G prüfen
    CheckValue = "" 'Bei diesem Wert Zeile anfügen
    CopyColFrom = "G"       'Von Spalte G...
    CopyColTo = "M"         'bis Spalte M bearbeiten

In der Spalte G bis M stehen die Werte die Kopiert werden sollen,
Von spalte A bis spalte F soll man seine Daten reinschreiben können (Name etc.)
 
   tRow = Target.row   'Aktuelle Zeile zwischenspeichern
    If Target.Value = "" And tRow > 1 And Range(CheckCol & tRow).Value = "" Then 'Weiter wenn Zelle Leer ist und sich min. in der 2ten Zeile befindet und CheckCol in dieser Zeile noch Leer ist
        If Range(CheckCol & tRow - 1).Value <> CheckValue Then   'Weiter Wenn Zelle oberhalb in der Spalte CheckCol den Wert CheckValue hat
            DropWS_SelChange = True 'Festlegen das diese sub nicht mehr aufgerufen werden darf
            Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow - 1).Select   'Bereich makieren
            Selection.AutoFill Destination:=Range(CopyColFrom & tRow - 1 & ":" & CopyColTo & tRow), Type:=xlFillDefault 'Bereich eines runter ziehen...
            Range("A" & tRow).Select    'Zelle in der Spalte CopyColFrom und der aktuellen Zeile auswählen
     
            DropWS_SelChange = False    'Sub wieder Freigeben...
        End If
    End If
ErrHandle:  'Sprungmarke die aufgerufen wird wenn ein Fehler auftritt...
End Sub

Nochmals vielen vielen Dank für die Hilfe und die Mühe.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück