Moin zusammen.
Ich muss in meinem Projekt Rohdaten (Excel) aus unserem WaWi-System verwursten, um Monatswerte zu bekommen
allerdings ist vb.net ja kein Excel und ich will ungern die Interop-Funktion nutzen müssen, da ich denke dass vb.net das auch so kann
Ich versuch's mal ordentlich zu erklären:
Die Rohdaten sind pro Monat eine Datei und sehen in etwa so aus:
Folgende relevante Spalten gibts in den Rohdaten:
Es gibt 3 Tourarten: (jede Tourart kann mehrere TourNr haben)
Versand
Abholer
Tour
Alle Werte können mehrfach vorkommen.
Was ich derzeit mit Excel-VBA mache:
Tabelle Nach Datum sortieren
Pro Datum:
alle Rows markieren, die zum Datum gehören und in ein neues Tabellenblatt kopieren
im neuen Tabellenblatt:
alle einträge nach Tour Sortieren. Alles was Versandtournummer ist -> Picks, Position, zeilen und eindeutige Kundennummern zählen
Alles was Abholer ist -> Positionen zählen
abschließend noch für den Tag zählen: gesamtzeilen, gesamt Picks, gesamt Position, gesamt eindeutige Kundennummern.
So erhalte ich pro Tag:
Position belieferte Kunden (gesamt-Positionen - abholer-Positionen - Versand-Positionen)
gesamtkunden
gesamtaufträge (zeilen)
gesamtpositionen
gesamtpicks
versandkunden
versandaufträge (zeilen)
versandpositionen
versandpicks
Danach dann mit dem nächsten Datum weitermachen.
Sieht dann fertig so aus:
Jetzt muss ich das Ganze irgendwie in vb.net nachbauen können.
Die Excel-Tabelle importiere ich mir in eine neue DataTable und schmeiße schonmal alle Zeilen raus, die ich nicht benötige
Monat und Jahr wird auf der Form ausgewählt, damit kann ich schonmal eine Schleife bauen (Do While datumMonatsanfang < datumMonatsende)
Was mir dazu fehlt:
- kann ich DataRows aus der QuellDataTable in eine neue (temporäre) DataTable kopieren? (z.B. alle Einträge die Datum = aktuelles Datum Schleife haben)
- gibt's eine Möglichkeit die Anzahl eindeutiger Werte (z.B. Kundennummer) aus einer Spalte auszulesen? (Ein Kunde kann mehrere Aufträge haben)
Codeansatz bis jetzt:
Spoiler anzeigen
Hier noch (falls interessant) der mit Sicherheit schlechteste Excel-VBA-Code, den die Welt gesehen hat (hab ich vor ein paar Jahren geschrieben)(aber klappt)
Spoiler anzeigen
EDIT: wird ggf. sogar reichen das nicht pro Tag sondern direkt für den ganzen Monat alles zu summieren (ändert aber recht wenig an dem Weg)
Ich muss in meinem Projekt Rohdaten (Excel) aus unserem WaWi-System verwursten, um Monatswerte zu bekommen
allerdings ist vb.net ja kein Excel und ich will ungern die Interop-Funktion nutzen müssen, da ich denke dass vb.net das auch so kann
Ich versuch's mal ordentlich zu erklären:
Die Rohdaten sind pro Monat eine Datei und sehen in etwa so aus:
Folgende relevante Spalten gibts in den Rohdaten:
Datum | Kundennummer | TourNr | Picks | Positionen |
Es gibt 3 Tourarten: (jede Tourart kann mehrere TourNr haben)
Versand
Abholer
Tour
Alle Werte können mehrfach vorkommen.
Was ich derzeit mit Excel-VBA mache:
Tabelle Nach Datum sortieren
Pro Datum:
alle Rows markieren, die zum Datum gehören und in ein neues Tabellenblatt kopieren
im neuen Tabellenblatt:
alle einträge nach Tour Sortieren. Alles was Versandtournummer ist -> Picks, Position, zeilen und eindeutige Kundennummern zählen
Alles was Abholer ist -> Positionen zählen
abschließend noch für den Tag zählen: gesamtzeilen, gesamt Picks, gesamt Position, gesamt eindeutige Kundennummern.
So erhalte ich pro Tag:
Position belieferte Kunden (gesamt-Positionen - abholer-Positionen - Versand-Positionen)
gesamtkunden
gesamtaufträge (zeilen)
gesamtpositionen
gesamtpicks
versandkunden
versandaufträge (zeilen)
versandpositionen
versandpicks
Danach dann mit dem nächsten Datum weitermachen.
Sieht dann fertig so aus:
Jetzt muss ich das Ganze irgendwie in vb.net nachbauen können.
Die Excel-Tabelle importiere ich mir in eine neue DataTable und schmeiße schonmal alle Zeilen raus, die ich nicht benötige
Monat und Jahr wird auf der Form ausgewählt, damit kann ich schonmal eine Schleife bauen (Do While datumMonatsanfang < datumMonatsende)
Was mir dazu fehlt:
- kann ich DataRows aus der QuellDataTable in eine neue (temporäre) DataTable kopieren? (z.B. alle Einträge die Datum = aktuelles Datum Schleife haben)
- gibt's eine Möglichkeit die Anzahl eindeutiger Werte (z.B. Kundennummer) aus einer Spalte auszulesen? (Ein Kunde kann mehrere Aufträge haben)
Codeansatz bis jetzt:
VB.NET-Quellcode
- Private Sub importLager()
- msgInformation("Bitte im Folgenden die Lagerdatei auswählen.")
- Dim importFile = openFile("Excel-Dateien (*.xlsx)|*.xlsx")
- If Not importFile = "" Then
- Using excelCon = New OleDbConnection("Provider = Microsoft.ACE.OLEDB.12.0; Data Source='" & importFile & "'; " & "Extended Properties='Excel 12.0;HDR=YES;IMEX=1;'")
- excelCon.Open()
- Using da = New OleDbDataAdapter("Select [Datum],[Li#-Kunde#Nummer],[Tour#Nr],[Picks],[Positions-Anzahl],[Ersteller#Info],[Umsatzart] From [Tabelle1$]", excelCon)
- Dim tblSrc As New DataTable("kennzahlenSource")
- da.Fill(tblSrc)
- Dim lstUmsatzarten = New List(Of String)
- Dim lstTourenOhneRelevanz = New List(Of String)
- Dim lstTourenVersand = New List(Of String)
- Dim lstTourenAbholer = New List(Of String)
- 'Optionen auslesen und in Listen packen
- For Each rwOpt In Dts.KennzahlenOpt
- If rwOpt.Standort = _standort Then
- For Each uArt In rwOpt.Umsatzarten.Split(","c)
- lstUmsatzarten.Add(uArt)
- Next
- For Each tNr In rwOpt.TourenOhneRelevanz.Split(","c)
- lstTourenOhneRelevanz.Add(tNr)
- Next
- For Each tNr In rwOpt.TourenVersand.Split(","c)
- lstTourenVersand.Add(tNr)
- Next
- For Each tNr In rwOpt.TourenAbholer.Split(","c)
- lstTourenAbholer.Add(tNr)
- Next
- End If
- Next
- 'Vorab unnötige Zeilen löschen
- For Each rwSrc As DataRow In tblSrc.Rows
- Dim ersteller = $"{rwSrc.Item("Ersteller#Info")}"
- Dim umsatzart = $"{rwSrc.Item("Umsatzart")}"
- Dim tournr = $"{rwSrc.Item("Tour#Nr")}"
- If Not ersteller Like "*Logistik*" Then
- rwSrc.Delete() 'alle Ersteller <> Logistik löschen
- End If
- For Each uArt In lstUmsatzarten
- If umsatzart = uArt Then rwSrc.Delete() 'irrelevante Umsatzarten löschen
- Next
- For Each tourOhneRelevanz In lstTourenOhneRelevanz
- If tournr = tourOhneRelevanz Then rwSrc.Delete() 'Touren ohne Relevanz löschen
- Next
- Next
- dgvSrc.DataSource = tblSrc 'bereinigte Daten in DGV anzeigen (nur für Testzwecke)
- 'Ab hier Verarbeitung der restlichen Daten
- Dim startDate = Date.Parse($"01.{_monatnummer}.{_setYear}")
- Dim endDate = MonatsEnde(_monatnummer.ToString, _setYear)
- Dim loopDate = startDate.Date
- Do While loopDate < endDate.Date.AddDays(1)
- Dim fahrerPos = 0 'Positionen belieferte Kunden
- Dim lagerKd = 0 'Kunden Lager
- Dim lagerAu = 0 'Aufträge Lager
- Dim lagerPos = 0 'Positionen Lager
- Dim lagerPicks = 0 'Picks Lager
- Dim paketKd = 0 'davon Kunden Paket
- Dim paketAu = 0 'davon Aufträge Paket
- Dim paketPos = 0 'davon Positionen Paket
- Dim paketPicks = 0 'davon Picks Paket
- Dim abholerPos = 0 'Positionen Abholer-Touren (für Berechnung Fahrer-Positionen nötig)
- For Each rw As DataRow In tblSrc.Rows
- If Not rw.RowState = DataRowState.Deleted Then
- 'alles was zu loopDate gehört in neue DT kopieren
- 'in neuer DT dann Werte auslesen
- End If
- Next
- 'wenn alle Werte für das Datum abgegriffen wurden, diese in das typDTS kopieren
- Dts.Kennzahlen.AddKennzahlenRow(loopDate, _standort, fahrerPos, lagerKd, lagerAu, lagerPos, lagerPicks,
- paketKd, paketAu, paketPos, paketPicks, 0, 0, 0, 0)
- Loop
- End Using
- End Using
- Else
- Return
- End If
- End Sub
Hier noch (falls interessant) der mit Sicherheit schlechteste Excel-VBA-Code, den die Welt gesehen hat (hab ich vor ein paar Jahren geschrieben)(aber klappt)
Quellcode
- Option Explicit
- 'Fenster on Top
- Public Const SWP_NOSIZE = &H1
- Public Const SWP_NOMOVE = &H2
- Public Const SWP_NOACTIVATE = &H10
- Public Const SWP_SHOWWINDOW = &H40
- Public Const HWND_TOPMOST = -1
- #If Win64 Then
- Public Declare PtrSafe Function SetWindowPos Lib "user32" ( _
- ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
- ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
- ByVal wFlags As Long) As Long
- Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
- ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
- #Else
- Public Declare Function SetWindowPos Lib "user32" ( _
- ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
- ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
- ByVal wFlags As Long) As Long
- Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
- ByVal lpClassName As String, ByVal lpWindowName As String) As Long
- #End If
- '
- Public shname As String
- Public wsNew As Worksheet
- Public mainwb As String, mainwbfull As String
- Public sourcewb_lager As String, sourcewbfull_lager As String
- Public sourcewb_sangro As String, sourcewbfull_sangro As String
- Public source_lager As String, source_sangro As String
- Public lager_active As Integer, sangro_active As Integer
- Public rmax As Long, cmax As Long, rmax_versand As Long, rmax_abholer As Long, rmax_touren As Long, rmax_mitarbeiter As Long, rmax_tag As Long, rmax_tag_summe As Long, rmax_datum As Long, row As Long, rmax_filter As Long, rmax_filtercopy As Long, rmax_umsatzart As Long
- Public i As Integer
- Public arr_monate As Variant
- Public ups As String
- Public formname As Object
- Public auswahl As String
- Public modulname As String
- Public jahr As String
- Public picks As Long, positionen As Long, auftrag As Long, kunden As Long, positionen_abholer As Long, positionen_versand As Long
- Public suchen As String, suchen_anzahl As Long
- Public rngRow As Range
- Public crit As String
- Public wks As Worksheet
- Sub daten()
- arr_monate = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember")
- jahr = Year(Now)
- End Sub
- Sub run_lager()
- On Error GoTo errhandler
- ups = ""
- Application.ScreenUpdating = False
- 'daten laden
- daten
- 'allgemeines
- wb_main
- 'prüfen, ob Vorlage noch vorhanden ist
- shname = "Vorlage"
- If Not sheet_exists(shname) Then
- MsgBox ("Das Tabellenblatt Vorlage ist nicht mehr vorhanden! Bitte an d.hornickel wenden"), vbCritical
- Exit Sub
- Else
- 'Monat auswählen
- frm_auswahl.ListBox1.List = arr_monate
- frm_auswahl.Show
- If Not auswahl = "" Then
- Application.ScreenUpdating = False
- 'Vorlage kopieren und Monat eintragen
- If sheet_exists(auswahl) Then
- Application.DisplayAlerts = False
- Sheets(auswahl).Delete
- Application.DisplayAlerts = True
- End If
- Sheets("Vorlage").Visible = True
- Sheets("Vorlage").Copy after:=Sheets(Sheets.Count)
- ActiveSheet.Name = auswahl
- Sheets("Vorlage").Visible = False
- Sheets(auswahl).Activate
- Select Case auswahl
- Case "Januar"
- Range("A3").Value = "01.01." & jahr
- Case "Februar"
- Range("A3").Value = "01.02." & jahr
- Case "März"
- Range("A3").Value = "01.03." & jahr
- Case "April"
- Range("A3").Value = "01.04." & jahr
- Case "Mai"
- Range("A3").Value = "01.05." & jahr
- Case "Juni"
- Range("A3").Value = "01.06." & jahr
- Case "Juli"
- Range("A3").Value = "01.07." & jahr
- Case "August"
- Range("A3").Value = "01.08." & jahr
- Case "September"
- Range("A3").Value = "01.09." & jahr
- Case "Oktober"
- Range("A3").Value = "01.10." & jahr
- Case "November"
- Range("A3").Value = "01.11." & jahr
- Case "Dezember"
- Range("A3").Value = "01.12." & jahr
- End Select
- 'Quelldaten laden
- quelldaten_lager_laden
- If Not source_lager = "Falsch" Then
- frm_progress.Show vbModeless
- 'Daten verarbeiten
- Sheets("source_lager").Activate
- cmax = Sheets("source_lager").UsedRange.Columns.Count
- rmax = Sheets("source_lager").UsedRange.Rows.Count
- 'Format Picks
- Columns("I:I").Select
- Selection.NumberFormat = "0"
- 'Summenzeile löschen
- If Range("D" & rmax).Value = "Summe" Then
- Rows(rmax).Delete
- End If
- 'umsatzart löschen
- rmax = Sheets("source_lager").UsedRange.Rows.Count
- rmax_umsatzart = Sheets("Start").Cells(Rows.Count, 1).End(xlUp).row
- frm_progress.bar_type.Max = rmax
- frm_progress.lbl_type.Caption = "Umsatzart löschen"
- For i = 2 To rmax
- fn_progress_u (i)
- If Not Sheets("Start").Range("A2:A" & rmax_umsatzart).Find(Sheets("source_lager").Range("AK" & i).Value) Is Nothing Then
- Rows(i).Delete
- i = i - 1
- If Range("AK" & i + 1).Value = "" Then
- Exit For
- End If
- End If
- Next
- i = 0
- rmax = Sheets("source_lager").UsedRange.Rows.Count
- 'nicht-Logistik Mitarbeiter löschen
- frm_progress.bar_type.Max = rmax
- frm_progress.lbl_type.Caption = "nicht-Logistik Mitarbeiter löschen"
- Dim suchbegriff As String
- suchbegriff = "*logistik*"
- For i = 2 To rmax
- Rows(i).Select
- fn_progress_u (i)
- If Not LCase(Cells(i, 15).Value) Like suchbegriff Then
- Rows(i).Delete
- i = i - 1
- If Range("A" & i + 1).Value = "" Then
- Exit For
- End If
- End If
- Next
- i = 0
- 'unnötige Touren rauslöschen
- rmax = Sheets("source_lager").UsedRange.Rows.Count
- rmax_touren = Sheets("Start").Cells(Rows.Count, 2).End(xlUp).row
- frm_progress.bar_type.Max = rmax
- frm_progress.lbl_type.Caption = "nicht relevante Touren löschen"
- For i = 2 To rmax
- fn_progress_u (i)
- 'Rows(i).Select
- If Not Sheets("Start").Range("B2:B" & rmax_touren).Find(Sheets("source_lager").Range("G" & i).Value) Is Nothing Then
- Rows(i).Delete
- i = i - 1
- If Range("A" & i + 1).Value = "" Then
- Exit For
- End If
- End If
- Next
- i = 0
- rmax = Sheets("source_lager").UsedRange.Rows.Count
- 'nach datum sortieren
- Columns(1).Resize(, cmax).EntireColumn.Select
- ActiveWorkbook.Worksheets("source_lager").Sort.SortFields.Clear
- ActiveWorkbook.Worksheets("source_lager").Sort.SortFields.Add Key:=Range("B2:B" & rmax), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- With ActiveWorkbook.Worksheets("source_lager").Sort
- .SetRange Range(ActiveWorkbook.Worksheets("source_lager").Cells(1, 1), ActiveWorkbook.Worksheets("source_lager").Cells(rmax, cmax))
- .Header = xlYes
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- 'Tag kopieren
- Dim day As Integer
- Dim dayend As Long
- Dim datum As String
- frm_progress.lbl_type = ""
- For day = 1 To 31
- kunden = 0
- positionen_abholer = 0
- positionen_versand = 0
- auftrag = 0
- positionen = 0
- picks = 0
- frm_progress.lbl_type_o.Caption = datum
- frm_progress.bar_gesamt.Max = 31
- fn_progress_o (day)
- datum = Range("B2").Value
- If Not datum = "" Then
- 'Tag sammeln
- For i = 2 To rmax
- If Not Cells(i, 2).Value = datum Then
- dayend = i - 1
- Exit For
- End If
- Next
- i = 0
- shname = datum
- If sheet_exists(shname) Then
- Application.DisplayAlerts = False
- Sheets(shname).Delete
- Application.DisplayAlerts = True
- End If
- Set wsNew = Worksheets.Add
- With wsNew
- .Name = shname
- .Move after:=Sheets(Sheets.Count)
- End With
- Set wsNew = Nothing
- Sheets("source_lager").Activate
- Range(Cells(1, 1), Cells(dayend, cmax)).Select
- Selection.Copy
- Sheets(datum).Activate
- Range("A1").Select
- Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
- xlNone, SkipBlanks:=False, Transpose:=False
- 'tag aus quelle löschen
- Sheets("source_lager").Activate
- Rows("2:" & dayend).Delete
- 'nach Tour sortieren
- Sheets(datum).Activate
- rmax_tag = Sheets(datum).UsedRange.Rows.Count
- Columns(1).Resize(, cmax).EntireColumn.Select
- ActiveWorkbook.Worksheets(datum).Sort.SortFields.Clear
- ActiveWorkbook.Worksheets(datum).Sort.SortFields.Add Key:=Range("G2:G" & rmax_tag), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- With ActiveWorkbook.Worksheets(datum).Sort
- .SetRange Range(ActiveWorkbook.Worksheets(datum).Cells(1, 1), ActiveWorkbook.Worksheets(datum).Cells(rmax_tag, cmax))
- .Header = xlYes
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- '#################
- 'Versand ermitteln
- '#################
- rmax_versand = Sheets("Start").Cells(Rows.Count, 3).End(xlUp).row
- shname = "Versand" & datum
- If sheet_exists(shname) Then
- Application.DisplayAlerts = False
- Sheets(shname).Delete
- Application.DisplayAlerts = True
- End If
- Set wsNew = Worksheets.Add
- With wsNew
- .Name = shname
- .Move after:=Sheets(Sheets.Count)
- End With
- Set wsNew = Nothing
- Sheets(shname).Activate
- rmax_filtercopy = ActiveSheet.UsedRange.Rows.Count
- Sheets(datum).Activate
- '
- For i = 2 To rmax_versand
- crit = Sheets("Start").Range("C" & i).Value
- 'prüfen, ob kriterium existiert
- suchen_anzahl = 0
- suchen_anzahl = Application.WorksheetFunction.CountIf(Sheets(datum).Range("G:G"), crit)
- If suchen_anzahl = 0 Then
- GoTo hierweiter
- End If
- Columns("G:G").Select
- Selection.AutoFilter
- ActiveSheet.Range("$G$1:$G$" & rmax_tag).AutoFilter Field:=1, Criteria1:=crit
- rmax_filter = ActiveSheet.UsedRange.Rows.Count
- Rows("2:" & rmax_filter).Select
- Selection.Copy
- Sheets(shname).Activate
- Range("A" & rmax_filtercopy).Select
- Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
- xlNone, SkipBlanks:=False, Transpose:=False
- rmax_filtercopy = ActiveSheet.UsedRange.Rows.Count + 1
- Sheets(datum).Activate
- Columns("G:G").Select
- Selection.AutoFilter
- hierweiter:
- Next
- Sheets(shname).Activate
- If Range("A1").Value = "" Then
- Sheets(datum).Activate
- GoTo versand_nixgefunden
- End If
- 'Aufträge
- Range("A" & rmax_filtercopy).Value = rmax_filtercopy - 1
- auftrag = Range("A" & rmax_filtercopy).Value
- 'Picks
- Range("I" & rmax_filtercopy).FormulaLocal = "=SUMME(I2:I" & rmax_filtercopy - 1 & ")"
- picks = Range("I" & rmax_filtercopy).Value
- 'Positionen
- Range("J" & rmax_filtercopy).FormulaLocal = "=SUMME(J2:J" & rmax_filtercopy - 1 & ")"
- positionen = Range("J" & rmax_filtercopy).Value
- positionen_versand = positionen
- 'doppelte Kunden löschen
- Columns("C:C").Select
- ActiveSheet.Range("$C$1:$C$" & rmax_filtercopy - 1).RemoveDuplicates Columns:=1, Header:=xlYes
- Range("C" & rmax_filtercopy).Value = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).row
- kunden = Range("C" & rmax_filtercopy).Value
- 'eintragen
- Sheets(auswahl).Activate
- 'datum suchen
- row = 0
- rmax_datum = ActiveSheet.UsedRange.Rows.Count
- i = 0
- For i = 1 To rmax_datum
- If Range("A" & i).Value = datum Then
- row = Range("A" & i).row
- Range("C" & row).Select
- Exit For
- End If
- Next i
- If row = 0 Then
- GoTo datumerror
- End If
- Range("H" & row).Value = kunden
- Range("I" & row).Value = auftrag
- Range("J" & row).Value = positionen
- Range("K" & row).Value = picks
- Sheets(datum).Activate
- versand_nixgefunden:
- 'Versandsheet löschen
- Application.DisplayAlerts = False
- Sheets(shname).Delete
- Application.DisplayAlerts = True
- '#################
- 'Abholer ermitteln
- '#################
- rmax_abholer = Sheets("Start").Cells(Rows.Count, 4).End(xlUp).row
- shname = "Abholer" & datum
- If sheet_exists(shname) Then
- Application.DisplayAlerts = False
- Sheets(shname).Delete
- Application.DisplayAlerts = True
- End If
- Set wsNew = Worksheets.Add
- With wsNew
- .Name = shname
- .Move after:=Sheets(Sheets.Count)
- End With
- Set wsNew = Nothing
- Sheets(shname).Activate
- rmax_filtercopy = ActiveSheet.UsedRange.Rows.Count
- Sheets(datum).Activate
- '
- For i = 2 To rmax_abholer
- crit = Sheets("Start").Range("D" & i).Value
- 'prüfen, ob kriterium existiert
- suchen_anzahl = 0
- suchen_anzahl = Application.WorksheetFunction.CountIf(Sheets(datum).Range("G:G"), crit)
- If suchen_anzahl = 0 Then
- positionen_abholer = 0
- GoTo hierweiter_abholer
- End If
- Columns("G:G").Select
- Selection.AutoFilter
- ActiveSheet.Range("$G$1:$G$" & rmax_tag).AutoFilter Field:=1, Criteria1:=crit
- rmax_filter = ActiveSheet.UsedRange.Rows.Count
- Rows("2:" & rmax_filter).Select
- Selection.Copy
- Sheets(shname).Activate
- Range("A" & rmax_filtercopy).Select
- Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
- xlNone, SkipBlanks:=False, Transpose:=False
- rmax_filtercopy = ActiveSheet.UsedRange.Rows.Count + 1
- Sheets(datum).Activate
- Columns("G:G").Select
- Selection.AutoFilter
- hierweiter_abholer:
- Next
- Sheets(shname).Activate
- 'doppelte Kunden löschen
- If Range("C1").Value = "" Then
- Sheets(datum).Activate
- GoTo abholer_nixgefunden
- End If
- Range("J" & rmax_filtercopy).FormulaLocal = "=SUMME(J2:J" & rmax_filtercopy - 1 & ")"
- positionen_abholer = Range("J" & rmax_filtercopy)
- Sheets(datum).Activate
- abholer_nixgefunden:
- 'Abholersheet löschen
- Application.DisplayAlerts = False
- Sheets(shname).Delete
- Application.DisplayAlerts = True
- '#####
- 'REST
- '#####
- rmax_tag_summe = rmax_tag + 1
- 'Aufträge
- Range("A" & rmax_tag_summe).Value = rmax_tag - 1
- auftrag = Range("A" & rmax_tag_summe).Value
- 'Picks
- Range("I" & rmax_tag_summe).FormulaLocal = "=SUMME(I2:I" & rmax_tag & ")"
- picks = Range("I" & rmax_tag_summe).Value
- 'Positionen
- Range("J" & rmax_tag_summe).FormulaLocal = "=SUMME(J2:J" & rmax_tag & ")"
- positionen = Range("J" & rmax_tag_summe).Value
- 'doppelte Kunden löschen
- Columns("C:C").Select
- ActiveSheet.Range("$C$1:$C$" & rmax_tag).RemoveDuplicates Columns:=1, Header:=xlYes
- Range("C" & rmax_tag_summe).Value = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).row - 1
- kunden = Range("C" & rmax_tag_summe).Value
- 'eintragen
- Sheets(auswahl).Activate
- 'datum suchen
- row = 0
- rmax_datum = ActiveSheet.UsedRange.Rows.Count + 1
- i = 0
- For i = 1 To rmax_datum
- Rows(i).Select
- If Range("A" & i).Value = datum Then
- row = Range("A" & i).row
- 'Range("C" & row).Select
- Exit For
- End If
- Next i
- If row = 0 Then
- GoTo datumerror
- End If
- Range("D" & row).Value = kunden
- Range("E" & row).Value = auftrag
- Range("F" & row).Value = positionen
- Range("G" & row).Value = picks
- Range("C" & row).Value = positionen - positionen_abholer - positionen_versand
- '
- Application.DisplayAlerts = False
- Sheets(datum).Delete
- Application.DisplayAlerts = True
- 'nächster Tag
- Sheets("source_lager").Activate
- End If
- Next
- '#########
- 'Aufräumen
- '#########
- Sheets(auswahl).Select
- Range("C3").Select
- Application.DisplayAlerts = False
- Sheets("source_lager").Delete
- Application.DisplayAlerts = True
- Unload frm_progress
- If MsgBox("Mit Sangro weitermachen?", Buttons:=vbYesNo + vbQuestion) = vbYes Then
- run_sangro
- Else
- Application.ScreenUpdating = True
- Exit Sub
- End If
- Else
- Sheets("Start").Activate
- Application.DisplayAlerts = False
- Sheets(auswahl).Delete
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- Exit Sub
- End If
- Else
- MsgBox "keine Auswahl getroffen, Abbruch!", vbExclamation
- Application.ScreenUpdating = True
- Exit Sub
- End If
- End If
- Application.ScreenUpdating = True
- Exit Sub
- datumerror:
- Unload frm_progress
- MsgBox "Das Datum " & datum & " aus der Quelldatei wurde in der Vorlage nicht gefunden, wurde der richtige Monat gewählt?", vbExclamation
- Sheets("Start").Activate
- 'alle sheets löschen
- Application.DisplayAlerts = False
- For Each wks In ThisWorkbook.Sheets
- If wks.Name <> "Start" And wks.Name <> "Vorlage" Then
- wks.Delete
- End If
- Next
- Application.DisplayAlerts = True
- Exit Sub
- errhandler:
- modulname = "run_lager"
- error.handler (ups)
- Unload frm_progress
- Sheets("Start").Activate
- 'alle sheets löschen
- Application.DisplayAlerts = False
- For Each wks In ThisWorkbook.Sheets
- If wks.Name <> "Start" And wks.Name <> "Vorlage" Then
- wks.Delete
- End If
- Next
- Application.DisplayAlerts = True
- Exit Sub
- End Sub
EDIT: wird ggf. sogar reichen das nicht pro Tag sondern direkt für den ganzen Monat alles zu summieren (ändert aber recht wenig an dem Weg)
"Na, wie ist das Wetter bei dir?"
"Caps Lock."
"Hä?"
"Shift ohne Ende!"
"Caps Lock."
"Hä?"
"Shift ohne Ende!"
Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „tragl“ ()