Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 67671 Skopiuj do schowka Problem z Tygodniowym Raportem
Autor Wiadomość
bazik123 
Fan Excela


Posty: 97
Wysłany: 30-03-2020, 03:13   Problem z Tygodniowym Raportem

Witam

W załączonym pliku, w arkuszu Raport znajduje się dynamiczna formula, która wyciąga zestaw danych z obecnego tygodnia.

Przy wpisaniu formuły z dużą ilością danych z kilku lat, formula nie wyciąga żadnych danych.

Czy jest możliwość napisania tej formuły w języku VBA? Lub zmodyfikowane formuły do wyciągania danych dużej ilości danych w różnych arkuszach?


Z góry dziękuje za pomoc.

Przyklad.xlsx
Pobierz Plik ściągnięto 13 raz(y) 47.96 KB

ID posta: 384499 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 614 razy
Posty: 3271
Wysłany: 30-03-2020, 06:38   

VBA.

Info:
1. Makro zdarzeniowe - reaguje na "ruszenie" (niekoniecznie modyfikację) kom. E2 w "raport".
2. Kod znajduje 1-sze wystąpienie wartości E2 w arkuszach źródłowych i kopiuje 7 kolejnych wierszy. 2 wyjątki:
- początek roku 2019
- przełom 2019/2020 (numeracja tygodni jest dyskusyjna).
3. Opcja "Zapisz kopię" jest niedopracowana (zapisuje niepotrzebnie cały skoroszyt i to jako .xlsm), tym niemniej:
- jako ścieżkę podstawia wartość B1 z ark. "Tyg"
- jako nazwę podstawia wartość E2.
4. Po uruchomieniu pliku E2 domyślnie ustawia się na bieżący tydzień > wykonuje się kod > stąd na "dzień dobry" pytanie o zapis kopii.

Testuj.
.

Kopia Przyklad.xlsm
Pobierz Plik ściągnięto 5 raz(y) 59.67 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 384500 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 30-03-2020, 19:10   

Do modułu normalnego wklej poniższy kod i uruchom.
Kod:
Sub Raport()
    Dim a(), rws
    Dim i As Integer, ii As Integer, lr As Integer
    Dim week As String
   
    With Sheets("Raport")
        week = .[E2]
        On Error Resume Next
        With Sheets(Left(week, 4))
            If Err.Number > 0 Then
                MsgBox "Nie ma arkusza o nazwie " & Left(week, 4) & " ."
                Exit Sub
            End If
            On Error GoTo 0
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            If lr > 4 Then
                a = .Range("A5:K" & lr).Value
                ReDim rws(1 To UBound(a), 1 To 1)
                For i = 1 To UBound(a)
                    If a(i, 1) = week Then
                        ii = ii + 1
                        rws(ii, 1) = i
                    End If
                Next
            End If
        End With
        .[A4].CurrentRegion.Offset(1, 0).ClearContents
        If ii > 0 Then
            .[A5].Resize(ii, UBound(a, 2)) = Application.Index(a, rws, Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")")))
        End If
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 384553 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 31-03-2020, 03:16   

Makro wyciąga dane tygodniowe, ale zamienia kolejność dni z miesiącem i czy jest możliwość, żeby odświeżała się samo czynie.

I czy jest możliwość zmienienia zakresów tak, aby mógłbym dostosować do pliku w pracy.

I załączam plik żebyś mógł sprawdzić, w czym tkwi problem.

Z góry dziękuje za pomoc.

Przyklad.xlsm
Pobierz Plik ściągnięto 6 raz(y) 52.23 KB

ID posta: 384567 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 31-03-2020, 09:14   

Odnośnie zamiany dni i miesięcy. Mój kod nie zamienia nic. Taki masz wybrany system daty (z * z przodu), że zależny on jest od ustawień regionalnych daty i godziny systemu operacyjnego.
Jedynie co mogę polecić, to zmienić format po skopiowaniu danych do arkusza 'raport'.
Do modułu arkusza 'raport' wklej kod. Dla Twoich potrzeb (automatycznego wykonywania raportu) wykorzystane jest zdarzenie 'Worksheet_Calculate'.
Kod:
Option Explicit

Private Sub Worksheet_Calculate()

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Raport Range("E2")
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
   
End Sub
Do modułu normalnego VBA poniższy kod.
Kod:
Sub Raport(rng As Range)
    Dim a(), rws
    Dim i As Integer, ii As Integer, lr As Integer
    Dim week As String
   
    With Sheets("Raport")
        week = rng.Value
        On Error Resume Next
        With Sheets(Left(week, 4))
            If Err.Number > 0 Then
                MsgBox "Nie ma arkusza o nazwie " & Left(week, 4) & " ."
                Exit Sub
            End If
            On Error GoTo 0
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            If lr > 4 Then
                a = .Range("A5:K" & lr).Value
                ReDim rws(1 To UBound(a), 1 To 1)
                For i = 1 To UBound(a)
                    If a(i, 1) = week Then
                        ii = ii + 1
                        rws(ii, 1) = i
                    End If
                Next
            End If
        End With
        .[A4].CurrentRegion.Offset(1, 0).ClearContents
        If ii > 0 Then
            With .[A5]
                .Resize(ii, UBound(a, 2)) = Application.Index(a, rws, _
                        Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")")))
                .Offset(0, 1).Resize(ii).NumberFormat = "mm/dd/yyyy"
            End With
        End If
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 384577 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 31-03-2020, 12:04   

Z pierwszego tygodnia wyciąga mi tylko 5 dni tygodnia z arkusza 2020, ale nie wyciąga mi dwóch pierwszych dni tygodnia z arkusza 2019.

Przyklad.xlsm
Pobierz Plik ściągnięto 4 raz(y) 53.75 KB

ID posta: 384587 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 31-03-2020, 13:12   

Pisałeś tak, że zrozumiałem, że ma szukać tylko w arkuszu z danym rokiem, a nie we wszystkich arkuszach ;-) .
_________________
Pozdrawiam.
ID posta: 384590 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 31-03-2020, 13:57   

Tę poprawkę wklej do modułu normalnego VBA (jak pisałem wcześniej), a nie do modułu arkusza 'raport'. Tam nie może byś kopiowany poniższy kod. Usuń go z modułu. Procedura zdarzeniowa 'Worksheet_Calculate()' pozostaje b/z.
Alt+F11--> zakładka 'Insert' --> Module i tutaj wklej.
Kod:
Dim a(), rws
Dim ii As Integer

Sub Raport(rng As Range)
    Dim i As Integer, lr As Integer
    Dim week As String
    Dim sh As Worksheet
   
    With Sheets("Raport")
        .[A4].CurrentRegion.Offset(1, 0).ClearContents
        week = rng.Value
        On Error Resume Next
        For Each sh In Worksheets
            If IsNumeric(sh.Name) Then
                With Sheets(sh.Name)
                    lr = .Cells(Rows.Count, "A").End(xlUp).Row
                    If lr > 4 Then
                        a = .Range("A5:K" & lr).Value
                        ReDim rws(1 To UBound(a), 1 To 1)
                        For i = 1 To UBound(a)
                            If a(i, 1) = week Then
                                ii = ii + 1
                                rws(ii, 1) = i
                            End If
                        Next
                    End If
                End With
                If ii > 0 Then DoRaportu
                ii = 0
            End If
        Next
        .[A4].CurrentRegion.Offset(1, 0).Columns(2).NumberFormat = "mm/dd/yyyy"
    End With
End Sub

Private Sub DoRaportu()
    With Sheets("raport")
        .Range("A" & .Cells(Rows.Count, "A").End(3).Row)(2).Resize(ii, UBound(a, 2)) = Application.Index(a, rws, _
                    Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")")))
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 384591 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 01-04-2020, 02:38   

Czy mógłbyś zmienić zakresów tabel, nowe zakresy są w załączonym pliku?

Z guru dziękuje. :-)

Przyklad.xlsm
Pobierz Plik ściągnięto 3 raz(y) 55.69 KB

ID posta: 384638 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 01-04-2020, 11:14   

W pierwszym załączniku nr tygodnia był wyznaczany z formuły i dlatego użyłem zdarzenia 'Worksheet_Calculate() do automatycznego raportowania przy zmianie danych. Teraz wpisujesz te dane 'z palca" stąd zmiana zdarzenia w arkuszu 'raport' na 'Worksheet_Change()', aby procedura wykonywała się tylko wtedy, gdy zmienisz coś w komórce 'C4' arkusza 'raport'.

Raport tygodniowy_2_kuma.xlsm
Pobierz Plik ściągnięto 12 raz(y) 59.05 KB

_________________
Pozdrawiam.
ID posta: 384657 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 01-04-2020, 13:58   

Dzięki Wielkie za pomoc wszystko działa idealnie. :-) :-)
ID posta: 384668 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 04-04-2020, 17:32   

Witam.

Mam problem z makro, przy kopiowaniu do pliku w pracy makro nie chce działać.

Kod:
ii = ii + 1


I nie wiem czemu niedziel.

I czy jest możliwość dostosowania własnego zakresu, z jakiej komórkami ma być przeszukiwana lista z każdego arkuszu zawierającego roczne dane. I dokładnie podana pierwsza komórka wklejanie listy do arkusza Raport. Tak, żebym mógł edytować zakresy w razie potrzeby.

Z góry dziękuje za pomoc.

Raport tygodniowy.xlsm
Pobierz Plik ściągnięto 9 raz(y) 55.65 KB

ID posta: 384955 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 04-04-2020, 22:24   

bazik123 napisał/a:
Mam problem z makro, przy kopiowaniu do pliku w pracy makro nie chce działać.
Kod:
ii = ii + 1
I nie wiem czemu niedziel.
To mi nic nie mówi, jaki jest opis błędu?
Możesz dołączyć screen z tego błędu?
Przekopiowałeś wszystko z tego modułu, również deklaracje zmiennych na poziomie modułu?
Kod:
Dim a(), rws
Dim ii As Integer
U mnie wszystko działa bez zastrzeżeń.

P.S. Dobrą praktyką jest mieć takie ustawienia modułu VBA jak niżej.
Moduł VBA -->zakładka Tools --> Options --> zakładka Editor "zaptaszkuj" wszystkie możliwości w tym również 'Require Variable Declaration'
Czyli wymuś deklarowanie wszystkich zmiennych przed ich użyciem.
_________________
Pozdrawiam.
ID posta: 384973 Skopiuj do schowka
 
 
bazik123 
Fan Excela


Posty: 97
Wysłany: 05-04-2020, 21:23   

Już działa makro poprawnie, po uzupełnieniu brakujących dat zaczęło działać poprawnie.

Po zmieniłem ustawienia tak jak zalecałeś.

Wielkie dzięki za pomoc. Wiszę ci Piwko :-)
ID posta: 385038 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe