Mefisto...diabeĹ czy anioĹ?
Witam wszystkich;)
Postaram się w skrócie opisać zagadnienie tworzonego przeze mnie makra:
- mam jeden plik, który odpowiada kalendarzowi i z niego jest pobierana interesująca mnie data (plik w załączniku pod nazwą kalendarz!!!.xls), tego pliku nie mogę ruszyć, nic w nim zmieniać, gdyż jest też wykorzystywany przez innych użytkowników w pracy;
- codziennnie do jednego folderu zapisywany jest plik o nazwie WK_ddmm.xls (ddmm = odpowiednia data, np. WK_0403.xls) i tak każdego dnia aż przez cały miesiąc zapełni się cały folder;
- ddmm jest wybierane na podstawie daty wprowadzonej w pliku kalendarz!!!.xls;
- z pliku WK_ddmm.xls odpowiednio każdego dnia pobierane są dane i zapisywane do zbiorczej tabelki w pliku pod nazwą Raporty.xls (plik w załączniku), są to zawsze te same adresy komórek w pliku WK_ddmm.xls;
- dodatkowo zapisywana też jest w kolumnie A pliku Raporty.xls data na podstawie kalendarz!!!.xls;
- natępnie użyłem dwukrotnie if w takim celu, aby po pierwsze:
*:jeżeli ktoś chce zaktualizować dane i wprowadza powiedzmy dwa razy tą samą datę, to dane są nadpisywane w tym samym wierszu, ma zostać przeszukany cały zakres dat, począwszy od komórki A5;
*:jeżeli natomiast data różni się od tych w kolumnie A, to ma po prostu dodać dane w pierwszym pustym wierszu.
Dodatek:)
- jezeli byłoby jeszcze możliwe wstawienie jakiegoś warunku, który by dodatkowo dodawał do kolumny A daty kolejno, to znaczy aby nie można byłoby pominąć daty, czyli dodać do kolejnego wiersza danych z pliku, np. WK_0403.xls zaraz po wierszu z danymi z pliku WK_0203, czy tam wcześniejszego, musi po prostu być zachowana kolejność dat.
Komu się to uda, wielki szacunek;)
Problemy z którymi się spotkałem:
- daty są źle porównywane, jeżeli dwa razy z rzędu wprowadzę tą samą datę, to dane się nadpiszą i wszystko jest w porządku, jeżeli natomiast, wpisana ponownie data jest oddzielona jakąś inną, wtedy nie jest nadpisywana, po prostu dane dodawane są do nowego wiersza.
Uwaga!!!
Pamiętajcie, że plik kalendarz!!!. xls jest nie do ruszenia, mogę zrobić tylko coś w samym kodzie albo w pliku Raporty.xls.
Sub JWCD()
Dim Wk_plik, Raport_1 As String
Dim dzien, mies, rok As String
Dim i, k, m, n As Integer
'Application.DisplayAlerts = False
Workbooks.Open Filename:="D:\statys\kalendarz!!!.xls" ' Lokalizację zostawiłem swoją;)
rok = Cells(5, 6).Value
mies = Cells(5, 5).Value
dzien = Cells(5, 4).Value
ActiveWorkbook.Close
Wk_plik = "\\uo-01\zuo\Pion_UO\Wydział_WA\WEW\Paliwa\20" & rok & "\M" & mies & "\WK_" & dzien & mies & ".xls"
Raport_1 = "Z:\Paliwa\Raporty.xls"
'Dane
Workbooks.Open Filename:=Raport_1
Sheets("Zapas na dni faktyczny").Select
'Range("A5").CurrentRegion.Select 'Zaznacza wszystkie dostępne dane
m = Range("A5").CurrentRegion.Rows.Count 'Zwraca liczbę zaznaczonych wierszy
'Cells(m + 2, 1).Select 'Zaznaczenie ostatniej aktywnej komórki
'I warunek na powtarzające się daty
For n = 5 To m + 2
If Cells(n, 1).Value = dzien & "-" & mies & "-" & "20" & rok Then
Workbooks.Open Filename:=Wk_plik
Range("J48").Select
Selection.Copy
Windows("Raporty.xls").Activate
Sheets("Zapas na dni faktyczny").Select
Cells(n, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
' I tak dalej kopiuję kolejne komórki aż do...
Windows("Raporty.xls").Activate
Cells(n, 14).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
ActiveWindow.Close 0
Windows("Raporty.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
End If
Next n
'II warunek na dodawanie daty do nowego wiersza
If Cells(m + 2, 1).Value <> dzien & "-" & mies & "-" & "20" & rok Then
Cells(m + 3, 1).Value = dzien & "-" & mies & "-" & "20" & rok
Workbooks.Open Filename:=Wk_plik
Range("J48").Select
Selection.Copy
Windows("Raporty.xls").Activate
Sheets("Zapas na dni faktyczny").Select
Cells(m + 3, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
' I tak dalej kopiuję kolejne komorki aż do...
Windows("Raporty.xls").Activate
Cells(m + 3, 14).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
ActiveWindow.Close 0
Windows("Raporty.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
End If
ActiveWorkbook.Save
End Sub
Pozdrawiam i z góry dziękuję za pomoc:)
zanotowane.pl doc.pisz.pl pdf.pisz.pl katkaras.opx.pl
Postaram się w skrócie opisać zagadnienie tworzonego przeze mnie makra:
- mam jeden plik, który odpowiada kalendarzowi i z niego jest pobierana interesująca mnie data (plik w załączniku pod nazwą kalendarz!!!.xls), tego pliku nie mogę ruszyć, nic w nim zmieniać, gdyż jest też wykorzystywany przez innych użytkowników w pracy;
- codziennnie do jednego folderu zapisywany jest plik o nazwie WK_ddmm.xls (ddmm = odpowiednia data, np. WK_0403.xls) i tak każdego dnia aż przez cały miesiąc zapełni się cały folder;
- ddmm jest wybierane na podstawie daty wprowadzonej w pliku kalendarz!!!.xls;
- z pliku WK_ddmm.xls odpowiednio każdego dnia pobierane są dane i zapisywane do zbiorczej tabelki w pliku pod nazwą Raporty.xls (plik w załączniku), są to zawsze te same adresy komórek w pliku WK_ddmm.xls;
- dodatkowo zapisywana też jest w kolumnie A pliku Raporty.xls data na podstawie kalendarz!!!.xls;
- natępnie użyłem dwukrotnie if w takim celu, aby po pierwsze:
*:jeżeli ktoś chce zaktualizować dane i wprowadza powiedzmy dwa razy tą samą datę, to dane są nadpisywane w tym samym wierszu, ma zostać przeszukany cały zakres dat, począwszy od komórki A5;
*:jeżeli natomiast data różni się od tych w kolumnie A, to ma po prostu dodać dane w pierwszym pustym wierszu.
Dodatek:)
- jezeli byłoby jeszcze możliwe wstawienie jakiegoś warunku, który by dodatkowo dodawał do kolumny A daty kolejno, to znaczy aby nie można byłoby pominąć daty, czyli dodać do kolejnego wiersza danych z pliku, np. WK_0403.xls zaraz po wierszu z danymi z pliku WK_0203, czy tam wcześniejszego, musi po prostu być zachowana kolejność dat.
Komu się to uda, wielki szacunek;)
Problemy z którymi się spotkałem:
- daty są źle porównywane, jeżeli dwa razy z rzędu wprowadzę tą samą datę, to dane się nadpiszą i wszystko jest w porządku, jeżeli natomiast, wpisana ponownie data jest oddzielona jakąś inną, wtedy nie jest nadpisywana, po prostu dane dodawane są do nowego wiersza.
Uwaga!!!
Pamiętajcie, że plik kalendarz!!!. xls jest nie do ruszenia, mogę zrobić tylko coś w samym kodzie albo w pliku Raporty.xls.
Sub JWCD()
Dim Wk_plik, Raport_1 As String
Dim dzien, mies, rok As String
Dim i, k, m, n As Integer
'Application.DisplayAlerts = False
Workbooks.Open Filename:="D:\statys\kalendarz!!!.xls" ' Lokalizację zostawiłem swoją;)
rok = Cells(5, 6).Value
mies = Cells(5, 5).Value
dzien = Cells(5, 4).Value
ActiveWorkbook.Close
Wk_plik = "\\uo-01\zuo\Pion_UO\Wydział_WA\WEW\Paliwa\20" & rok & "\M" & mies & "\WK_" & dzien & mies & ".xls"
Raport_1 = "Z:\Paliwa\Raporty.xls"
'Dane
Workbooks.Open Filename:=Raport_1
Sheets("Zapas na dni faktyczny").Select
'Range("A5").CurrentRegion.Select 'Zaznacza wszystkie dostępne dane
m = Range("A5").CurrentRegion.Rows.Count 'Zwraca liczbę zaznaczonych wierszy
'Cells(m + 2, 1).Select 'Zaznaczenie ostatniej aktywnej komórki
'I warunek na powtarzające się daty
For n = 5 To m + 2
If Cells(n, 1).Value = dzien & "-" & mies & "-" & "20" & rok Then
Workbooks.Open Filename:=Wk_plik
Range("J48").Select
Selection.Copy
Windows("Raporty.xls").Activate
Sheets("Zapas na dni faktyczny").Select
Cells(n, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
' I tak dalej kopiuję kolejne komórki aż do...
Windows("Raporty.xls").Activate
Cells(n, 14).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
ActiveWindow.Close 0
Windows("Raporty.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
End If
Next n
'II warunek na dodawanie daty do nowego wiersza
If Cells(m + 2, 1).Value <> dzien & "-" & mies & "-" & "20" & rok Then
Cells(m + 3, 1).Value = dzien & "-" & mies & "-" & "20" & rok
Workbooks.Open Filename:=Wk_plik
Range("J48").Select
Selection.Copy
Windows("Raporty.xls").Activate
Sheets("Zapas na dni faktyczny").Select
Cells(m + 3, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
' I tak dalej kopiuję kolejne komorki aż do...
Windows("Raporty.xls").Activate
Cells(m + 3, 14).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("WK_" & dzien & mies & ".xls").Activate
ActiveWindow.Close 0
Windows("Raporty.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
End If
ActiveWorkbook.Save
End Sub
Pozdrawiam i z góry dziękuję za pomoc:)