Witam.
Znów mam problem z Excelem. Mianowicie w firmie gdzie pracuje człowiek człowiekowi wilkiem przy wysyłaniu zbiorczego planu dostaw przewoźnicy się burzą że jeden ma lepiej drugi gorzej. Że ktoś jest bardziej faworyzowany inny mniej. Wpadłem na pomysł żeby skombinować makro, które dzieli plan dostaw na oddzielne pliki, takie, w których przewoźnik otrzymuje tylko informacje o trasach i załadunkach dla swoich aut. Wtedy skończą się płacze że ktoś ma lepiej, bo przestaną sobie wzajemnie kilometry liczyć.
Jako, że w makrach to ogólnie najlepszy nie jestem z pomocą wujka google wykombinowałem dwa makra (plik xlsm w załączniku).
Pierwsze, które dzieli plan na oddzielne arkusze na podstawie danych zawartych w kolumnie D (ta z kolei ma odniesienie do arkusza z bazą aut przydzielonych dla danych przewoźników):
Drugi, który każdy z arkuszy zapisuje jako oddzielny plik:
Działa jako tako chociaż mam z tym kilka problemów których nie mogę rozwiązać:
Pierwszy to w filename probowałem dopisać żeby nazwa pliku składała się z nazwy arkusza (w tym wypadku nazwy przewoźnika), daty z komórki D1 (formuła Dziś()+1, bo plan przy wysyłaniu dotyczy kolejnego dnia) oraz zapisanego w formacie .xls.
Pliki sie zapisuja co prawda bez daty, ale przy otwarciu pliku otrzymuje komunikat że plik który probuje otworzyć ma inny format niż określony przez rozszerzenie pliku.
Drugi to fakt, że plan transportowy składa się z kilku różnych zakładek. Po jednej dla każdego z magazynów. Ci sami przewoźnicy mają auta przypisane do różnych magazynów. Więc idealnym wyjsciem byłoby tworzyć plik z trasami każdego z przewoźników z każdym magazynem oddzielnie w arkuszach. Chodziaż to takie wydziwianie jest bo plan na dobra sprawę trzeba by wpisać tą formułe z kolumny D w każdy arkusz. Więc ogólnie zamysł jest taki, żeby każdy magazyn dzielić oddzielnie i tworzyć np po 4 pliki po jednym dla każdego magazynu, które będą wysyłane do przewoźników. Wtedy zmienić makro tak żeby nazwa pliku zapisywała się jako przewoźnik - data - magazyn1.xls itd. Potem tylko poszukać w thunderbirdzie odpowiedniego dodatku który rozsyła spam (
) każdy plik na podstawie nazwy do wskazanej grupy adresów.
Znów mam problem z Excelem. Mianowicie w firmie gdzie pracuje człowiek człowiekowi wilkiem przy wysyłaniu zbiorczego planu dostaw przewoźnicy się burzą że jeden ma lepiej drugi gorzej. Że ktoś jest bardziej faworyzowany inny mniej. Wpadłem na pomysł żeby skombinować makro, które dzieli plan dostaw na oddzielne pliki, takie, w których przewoźnik otrzymuje tylko informacje o trasach i załadunkach dla swoich aut. Wtedy skończą się płacze że ktoś ma lepiej, bo przestaną sobie wzajemnie kilometry liczyć.
Jako, że w makrach to ogólnie najlepszy nie jestem z pomocą wujka google wykombinowałem dwa makra (plik xlsm w załączniku).
Pierwsze, które dzieli plan na oddzielne arkusze na podstawie danych zawartych w kolumnie D (ta z kolei ma odniesienie do arkusza z bazą aut przydzielonych dla danych przewoźników):
Sub DzielNaArkusze()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 4
Set ws = Sheets("Plan")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:D1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
Drugi, który każdy z arkuszy zapisuje jako oddzielny plik:
Sub ArkuszeNaPliki()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & D1 & ".xls"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
Działa jako tako chociaż mam z tym kilka problemów których nie mogę rozwiązać:
Pierwszy to w filename probowałem dopisać żeby nazwa pliku składała się z nazwy arkusza (w tym wypadku nazwy przewoźnika), daty z komórki D1 (formuła Dziś()+1, bo plan przy wysyłaniu dotyczy kolejnego dnia) oraz zapisanego w formacie .xls.
Pliki sie zapisuja co prawda bez daty, ale przy otwarciu pliku otrzymuje komunikat że plik który probuje otworzyć ma inny format niż określony przez rozszerzenie pliku.
Drugi to fakt, że plan transportowy składa się z kilku różnych zakładek. Po jednej dla każdego z magazynów. Ci sami przewoźnicy mają auta przypisane do różnych magazynów. Więc idealnym wyjsciem byłoby tworzyć plik z trasami każdego z przewoźników z każdym magazynem oddzielnie w arkuszach. Chodziaż to takie wydziwianie jest bo plan na dobra sprawę trzeba by wpisać tą formułe z kolumny D w każdy arkusz. Więc ogólnie zamysł jest taki, żeby każdy magazyn dzielić oddzielnie i tworzyć np po 4 pliki po jednym dla każdego magazynu, które będą wysyłane do przewoźników. Wtedy zmienić makro tak żeby nazwa pliku zapisywała się jako przewoźnik - data - magazyn1.xls itd. Potem tylko poszukać w thunderbirdzie odpowiedniego dodatku który rozsyła spam (
) każdy plik na podstawie nazwy do wskazanej grupy adresów.