Microsoft Excel

Herbers Excel/VBA-Archiv

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

Vb Archiv: wenn zellwert "0" zeile verschieben

Betrifft: Vb Archiv: wenn zellwert "0" zeile verschieben von: Kevin
Geschrieben am: 09.09.2014 08:04:43

Hallo,

Ich habe eine Mappe mit mehreren Blättern
Auf 2 Blättern
(welche für diese Frage relevant sind)
Habe ich einen als Tabelle Formatierten Bereich
(auf beiden Blättern im selben Bereich)

Was ich jetzt suche ist ein Vb Code/Makro
Der für jede Zeile meines Blattes(Aktuell) für die folgendes zutrifft,
Feld [offene Std.] 0,00
Feld [KW] Kleiner/Gleich einer abgefragten Größe (inputbox)
Die gesamte Zeile (also die werte) auf das andere Blatt (Archiv)
in die dort vorhandene Tabelle verschiebt

Das hinterher zu sortieren etc. krieg ich schon hin
aber diese "Archivierung" bereitet mir Kopfschmerzen.

Help Please

Grüße Kevin


  

Betrifft: AW: Vb Archiv: wenn zellwert "0" zeile verschieben von: Crazy Tom
Geschrieben am: 10.09.2014 09:20:23

Hallo Kevin

so habe ich es getestet

Option Explicit

Sub suchen_kopieren()
    Dim lngLetzte As Long
    Dim Suchwert As Long
    Dim lngZiel As Long
    Dim lngZaehler As Long
    lngZiel = Sheets("Archiv").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Suchwert = InputBox("Kalenderwoche eingeben", "Suche")
    With Sheets("Aktuell")
Application.ScreenUpdating = False
        lngLetzte = Cells(Rows.Count, 4).End(xlUp).Row
        For lngZaehler = lngLetzte To 5 Step -1
            If Cells(lngZaehler, 4) <= Suchwert And Cells(lngZaehler, 10) = 0 Then
                Rows(lngZaehler).EntireRow.Copy
                Sheets("Archiv").Range("A" & lngZiel).PasteSpecial
                Rows(lngZaehler).EntireRow.Delete shift:=xlUp
                lngZiel = lngZiel + 1
            End If
        Next
Application.ScreenUpdating = True
    End With
End Sub

in meinem Test ist die Spalte mit den KWs in Spalte D(4)
und die offenen Stunden in Spalte J (10)
die Datenreihen beginnen bei mir in Zeile 5

MfG Tom


  

Betrifft: AW: Vb Archiv: wenn zellwert "0" zeile verschieben von: Kevin
Geschrieben am: 10.09.2014 12:59:12

Wow mega danke,

soviel Hilfe hätte ich auf Anhieb nicht erwartet ;)

Habe deinen Code an meine Mappe angepasst sowie noch einen Schnipsel hinzugefügt
der verhindert das Excel die erste Zeile, des als Tabelle formatierten Bereiches,
leer lässt.

Das ganze sieht jetzt so aus

Private Sub CommandButton3_Click()
   
    Dim lngLetzte As Long
    Dim Suchwert As Long
    Dim lngZiel As Long
    Dim lngZaehler As Long
'Umgehung der leeren zeile in Formatierter Tabelle
    If Not Sheets("Archiv").Range("B11") > "0" Then
    lngZiel = Sheets("Archiv").Cells(Rows.Count, 2).End(xlUp).Row
    Else
    lngZiel = Sheets("Archiv").Cells(Rows.Count, 2).End(xlUp).Row + 1
    End If
'Ende der Umgehung
    'lngZiel = Sheets("Archiv").Cells(Rows.Count, 2).End(xlUp).Row + 1
    Suchwert = InputBox("Kalenderwoche eingeben", "Suche")
    With Sheets("Aktuell")
Application.ScreenUpdating = False
        lngLetzte = Cells(Rows.Count, 5).End(xlUp).Row
        For lngZaehler = lngLetzte To 11 Step -1
            If Cells(lngZaehler, 5) <= Suchwert And Cells(lngZaehler, 11) = 0 Then
                Rows(lngZaehler).EntireRow.Copy
                Sheets("Archiv").Range("A" & lngZiel).PasteSpecial
                Rows(lngZaehler).EntireRow.Delete shift:=xlUp
                lngZiel = lngZiel + 1
            End If
        Next
Application.ScreenUpdating = True
    End With

End Sub
und jetzt das "Aber" =)

Am ende des Codes möchte ich das er den als Tabelle formatierten bereich "erweitert"
ich dachte mir ich nutze lngziel, ziehe eins ab um die letzte Zeile zu definieren
aber wie kriege ich das im Code umgesetzt

weil... so funktioniert das nicht =)
(wie unerwartet,,, :D )
 
.....
Application.ScreenUpdating = True
    End With
   
lngZiel = lngZiel - 1
Sheets("Archiv").ListObjects("Tabelle13").Resize Range("$B$10:$K$lngziel")

End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Vb Archiv: wenn zellwert "0" zeile verschieben"