Office: (Office 2010) [VBA] werte auslesen und in neues Tabellenblatt kopieren

Hallo an alle,

ich bin neu hier und auch noch ein ziemlicher Anfänger, wenn es um das Thema VBA geht.
Ich hoffe, dass mir hier jemand bei meinem Problem helfen kann. Dafür habe ich auch die Testdatei von mir mit angehangen.

Folgendest möchte ich tun:
In das Tabellenblatt "Bestand" soll aus dem "Chargenblatt" die Chargen# und die Länge 1 bis 5 (nur wenn ein Wert vorhanden ist) kopiert werden.
Dabei sollen die Längen untereinander angeortnet werden, mit der passenden Chargen#
Das heißt:
Chargen#____Länge
456456______2555
4646________1600
4646________150
4646________800
46464_______2560 ...usw.

Momentan wird dies durch "Sammel_Daten" durchgeführt. Dabei wird die Liste ständig gelöscht und neu geschrieben.
Da aber die Datenmenge immer größer wird und der Vorgang immer länger dauert, hätte ich gern eine Lösung, dass nur noch neue Daten kopiert werden und so die Liste aktuell gehalten wird.

Ich hoffe, dafür gibt es eine Lösung und ich danke euch schonmal für eure Hilfe.

Grüße

 

Hallo QMLer,

du kannst doch einfach im Bestand die letzte Chargennummer abfragen, diese im Chargenblatt suchen und die Daten ab der folgenden Charge übertragen.
Oder versteh ich da was falsch?

Gruß,
Lutz

 

Hallo Lutz.
Da ich die Tabellen nicht jeden Tag ständig selbst verwalten möchte und die Produktion nicht gerade gut mit Excel umgehen kann, soll dies automatisch geschehen, damit der Bestand immer aktuell ist. Es arbeiten auch mehrer Leute in dieser Tabelle. Der Sinn dahinter steht, alles so einfach wie möglich zu gestaltten und die Eingabezeiten zu minimieren.
Außerdem kommen im Normalfall etwa 100 bis 200 Daten pro Tag dazu.

Grüße

 

Hallo QMLer,

hmm, ich weiß jetzt nicht genau, worauf du hinaus willst.
Aktuell aktualisierst Du die Datei automatisch, sobald das Blatt Bestand aktiviert wird. Je mehr Daten du hast, desto länger dauert diese Aktualisierung.

Mein Vorschläg wäre, dass Du den Ablauf so lässt, aber nicht alles löscht und neu schreibst, sondern
-die letzte Chargennummer im Bestand ausliest
-diese Chargennummer im Chargenblatt suchst
-alle folgenden Chargen in den Bestand schreibst
Alles automatisch, nur mit den wirklich neuen Chargen.

Gruß,
Lutz

 

Probier mal das (ist ungetestet):

Code:

Sub Sammeln_Daten()
Dim ZeileBestand As Long, LZeileCharge As Long, EZeileCharge As Long
Dim N As Long, I As Integer
Dim WSBestand As Worksheet
Dim WSChargen As Worksheet
Dim LetzterBestand

Set WSBestand = Worksheets("Bestand")
Set WSChargen = Worksheets("Chargenblatt")

ZeileBestand = WSBestand.Cells(Rows.Count, 1).End(xlUp).Row
LetzterBestand = Cells(ZeileBestand, 1).Value

WSChargen.Activate
LZeileCharge = WSBestand.Cells(Rows.Count, 1).End(xlUp).Row
For Zeile = 2 To LZeileCharge
    If Cells(Zeile, 2) = LetzterBestand Then
        Exit For
    End If
Next Zeile
EZeileCharge = Zeile

ZeileBestand = ZeileBestand + 1

With Worksheets("Chargenblatt")
     For N = EZeileCharge To LZeileCharge
         I = 5
         Do While .Cells(N, I).Value > 0
            WSB.Cells(ZeileBestand, 1).Value = .Cells(N, 2).Value
            WSB.Cells(ZeileBestand, 2).Value = .Cells(N, I).Value
            I = I + 1
            ZeileBestand = ZeileBestand + 1
        Loop
     Next
End With
Set WSBestand = Nothing
Set WSChargen = Nothing
End Sub

Gruß,
Lutz

 

Hallo Lutz,

genau das meine ich. Der Code scheint das zu machen. Ich kann bloß nicht mehr auf dem Bestand bleiben, da er immer automatisch auf das Chargenblatt zurück springt.
Und wie ich gerade gesehen habe, kopiert er immer die letzte Chargennummer, sobald man den Bestand anklickt.

Grüße

 

Stimmt. Mein Fehler.

Nach dem EndWith einfach
WSBestand.Activate
einfügen.

 

Hallo Lutz,

jetzt dreht die Datei völlig durch. Springt wie wild zwischen Chargenblatt und Bestand hin und her.
Ich lad mal die Fehlerhafte Datei hoch.

 

Oh Mann, das passiert, wenn man Code einfach so hinrotzt und nicht nachdenkt.
Durch WSBestand.Activate wird natürlich das Blatt Bestand ausgewählt und der Code läuft erneut ab.

Also:
Application.EnableEvents = False
WSBestand.Activate
Application.EnableEvents = True

 

Super. Ich dank dir schonmal für deine Mühe.
Jetzt gibt es nur noch einen kleinen Fehler. Immer wenn ich auf Bestand klicke, kopiert er die letzte Nummer, auch wenn keine neuen Nummern hinzugekommen sind.

 

Waren noch zwei kleine Fehler drin.

Code:

Sub Sammeln_Daten()
Dim ZeileBestand As Long, LZeileCharge As Long, EZeileCharge As Long, Zeile As Long
Dim N As Long, I As Integer
Dim WSBestand As Worksheet
Dim WSChargen As Worksheet
Dim LetzterBestand

Set WSBestand = Worksheets("Bestand")
Set WSChargen = Worksheets("Chargenblatt")

ZeileBestand = WSBestand.Cells(Rows.Count, 1).End(xlUp).Row
LetzterBestand = Cells(ZeileBestand, 1).Value

WSChargen.Activate
LZeileCharge = WSChargen.Cells(Rows.Count, 1).End(xlUp).Row
For Zeile = 2 To LZeileCharge
    If Cells(Zeile, 2) = LetzterBestand Then
        Exit For
    End If
Next Zeile
EZeileCharge = Zeile

ZeileBestand = ZeileBestand + 1

With Worksheets("Chargenblatt")
     For N = EZeileCharge + 1 To LZeileCharge
         I = 5
         Do While .Cells(N, I).Value > 0
            WSBestand.Cells(ZeileBestand, 1).Value = .Cells(N, 2).Value
            WSBestand.Cells(ZeileBestand, 2).Value = .Cells(N, I).Value
            I = I + 1
            ZeileBestand = ZeileBestand + 1
        Loop
     Next
End With
Application.EnableEvents = False
WSBestand.Activate
Application.EnableEvents = True
Set WSBestand = Nothing
Set WSChargen = Nothing
End Sub

Jetzt sollte es laufen.

 

Hallo Lutz,

es funktioniert. Ich dank dir wie verrückt für deine Hilfe. Das erleichtert hier nun einiges.

Grüße

 

Dafür ist das Forum ja da.

 

Hallo.

Erstmal der Code funktioniert echt super.
Leider ist ein neues Problem aufgetaucht. Wenn in der Tabelle eine "Länge 5" eingetragen wurde, kopiert er in den Besatnd den Ausschuss und die verwendbare Länge mit rein. Also läuft quasi der solange, bis er bei einer leeren Spalte angekommen ist.
Momentan habe ich eine leere Spalte versteckt, damit er aufhört zu kopieren.
Gibt es dafür eventuell noch eine eleganter Lösung?

Grüße

PS: Anbei die aktuell laufende Version.

 

Hallo QMLer,

das liegt an Deiner Do-Loop-Schleife. Bei solchen Schleifen immer aufpassen, ob das Abbruchkriterium wirklich erreicht wird, sonst läufts in eine Endlosschleife oder wie bei Dir kopierts unerwünschte Daten.

Ändere einfach Deinen Code in eine For-Next-Schleife. Du weißt ja, wieviele Zellen Du maximal abgreifen willst. Und die leere Zelle schreibst Du noch als If-Abfrage rein, damit reduzierst Du unnötige Durchläufe.

Code:

With Worksheets("Chargenblatt")
     For N = EZeileCharge + 1 To LZeileCharge
         For I = 5 To 9
            If .Cells(N, I).Value = 0 Then
                Exit For
            End If
            WSBestand.Cells(ZeileBestand, 1).Value = .Cells(N, 2).Value
            WSBestand.Cells(ZeileBestand, 2).Value = .Cells(N, I).Value
            I = I + 1
            ZeileBestand = ZeileBestand + 1
        Next I
     Next N
End With

Gruß,
Lutz