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: 67740 Skopiuj do schowka Kopiowanie zakresów
Autor Wiadomość
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 03-04-2020, 20:17   Kopiowanie zakresów

Witam wszystkich,
chcę zaznaczyć do kopiowania pewien zakres danych, który jest dynamiczny.
Moja ilość wierszy do zaznaczenia to akurat w tym przypadku od pierwszego występującego wiersza z 2020-04-03 do ostatniego z datą 2020-04-11, daty mam ustawione w zmiennych.
Może też się zdarzyć, że akurat nie będzie tego 2020-04-11 (np. ktoś zapomniał wpisać), wtedy chciałbym, aby zakres zakończył się na ostatniej wcześniejszej/dostępnej dacie np. 2020-04-10.
Jeżeli kolumna z datą będzie pusta, to wcale nie kopiuj.
Co zrobić by w arkuszu do którego chce to kopiować zaczynać doklejać dane od pierwszego niepustego wiersza? Sprawdzać ilość niepustych wierszy i dodawać do tej wyniku na końcu 1?

Z góry dziękuje za pomoc i wskazówki. :-)

Kopia.xls
Pobierz Plik ściągnięto 14 raz(y) 41 KB

_________________
canto
ID posta: 384900 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2888 razy
Posty: 9578
Wysłany: 04-04-2020, 00:39   

canto napisał/a:
Jeżeli kolumna z datą będzie pusta, to wcale nie kopiuj.
Jeżeli wiesz, że wiersz nagłówkowy tabeli zaczyna się w 4. wierszu arkusza, to szukaj ostatniego wiersza niepustej komórki w kolumnie daty
Kod:
Cells(Rows.Count,"D").End(xlUp).Row
Jeżeli powyższe zwróci 4, to znaczy że kolumna jest pusta. Można też zastosować inne rozwiązanie na sprawdzenie, czy kolumna jest pusta.
canto napisał/a:
Może też się zdarzyć, że akurat nie będzie tego 2020-04-11 (np. ktoś zapomniał wpisać), wtedy chciałbym, aby zakres zakończył się na ostatniej wcześniejszej/dostępnej dacie np. 2020-04-10.
To wydaje się nieco prostsze niż data początkowa. Jeżeli daty są posortowane rosnąco, to można zastosować w kodzie funkcję arkuszową PODAJ.POZYCJĘ, z ostatnim parametrem ustawionym na 1,np.:
Kod:
  With Cells(4, 1).CurrentRegion.Columns(4)
      MsgBox Application.Match(CLng(Date + 10), .Cells, 1)
  End With
Jeżeli Date+10 zwraca datę z poza zakresu dostępnych dat, to zwróci ostatnią pozycję w tabeli. Podobnie gdy data jest dostępna, to zwróci pozycję ostatniego wystąpienia szukanej daty.
canto napisał/a:
od pierwszego występującego wiersza z 2020-04-03
Na razie nie wiadomo jak do tego podejść w przypadku braku daty startowej. Domniemam jedynie, że w takim przypadku szukamy pierwszej dostępnej daty po szukanej. Najpierw powinniśmy zbadać, czy data szukana jest
Kod:
  With Cells(4, 1).CurrentRegion.Columns(4)
      MsgBox Application.Match(CLng(Date - 2), .Cells, 0)
  End With
Jeżeli jest, no to jest. :-) Zwrócona zostanie pierwsza pozycja szukanej daty. Jeśli nie ma, poszukamy ostatniej pozycji daty mniejszej od szukanej, czyli jak przy szukaniu pozycji daty końcowej
Kod:
  With Cells(4, 1).CurrentRegion.Columns(4)
      MsgBox Application.Match(CLng(Date - 2), .Cells, 1)
  End With
Teraz wystarczy dodać 1 i mamy pozycję pierwszej daty większej od daty szukanej.
canto napisał/a:
Co zrobić by w arkuszu do którego chce to kopiować zaczynać doklejać dane od pierwszego niepustego wiersza? Sprawdzać ilość niepustych wierszy i dodawać do tej wyniku na końcu 1?
Jeżeli masz pewność, że wszystkie wiersze w przeszukiwanej kolumnie są wypełnione, to zliczenie niepustych jest jednym z rozwiązań. Innym jest sposób podany na samym początku, gdzie do wyniku dodasz 1.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 384919 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 04-04-2020, 21:05   

Dla tego fragmentu kodu na załączonym pliku:
Kod:
  With Cells(4, 1).CurrentRegion.Columns(4)
      MsgBox Application.Match(CLng(Date - 2), .Cells, 0)
  End With

zwróciło mi 7, więc chyba czegoś nie łapię :-)
_________________
canto
ID posta: 384968 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 613 razy
Posty: 3265
Wysłany: 04-04-2020, 21:13   

Dobrze ci zwróciło: 7-my wiersz licząc od 4-go.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 384969 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 04-04-2020, 21:25   

Próbuję to dostosować jakoś pod siebie, a to moja pierwsza data szukana (powiedzmy 2020-04-03), nie za bardzo jednak ogarniam składnię tej funkcji... :-/ Teoretycznie szukam wiersza 15.

Kod:
Sub aaa()
Dim a As Date
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
MsgBox Application.Match(CLng(a - 2), .Cells, 0)
End With
 
End Sub
_________________
canto
ID posta: 384970 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 613 razy
Posty: 3265
Wysłany: 04-04-2020, 21:37   

Zał.
.

Kopia Kopia.xlsm
Pobierz Plik ściągnięto 12 raz(y) 20.39 KB

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



Wersja: Win Office 2016
Posty: 246
Wysłany: 05-04-2020, 16:07   

Dostępny zakres 2020-04-01 ---2020-04-12
Funkcja dla daty początkowej:
Kod:
Private Sub CommandButton1_Click()
Dim a As Date
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
MsgBox Application.Match(CLng(a), .Cells, 0) + 3
End With
 
End Sub

Option Explicit


2020-04-01 znajduje mi 5 ok
2020-04-02 znajduje mi 10 ok
2020-03-31 wywala mi błąd a powinno wyrzucić 5

Funkcja dla daty końcowej
Kod:
Private Sub CommandButton1_Click()
Dim a As Date
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
MsgBox Application.Match(CLng(a), .Cells, 1) + 3
End With
 
End Sub

Option Explicit


2020-04-01 znajduje mi 9 ok
2020-04-12 znajduje mi 34 ok
2020-04-13 znajduje mi 34 ok

Jak zmodyfikować dla daty początkowej, by brało pierwszą dostępną?
_________________
canto
ID posta: 385011 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 613 razy
Posty: 3265
Wysłany: 05-04-2020, 18:09   

Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim a As Date, t As Variant

On Error Resume Next
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
    If IsError(Application.Match(CLng(a), .Cells, 0) + 3) Then
        t = 5
    Else
        t = Application.Match(CLng(a), .Cells, 0) + 3
    End If
    MsgBox t
End With
 
End Sub
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 385018 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 05-04-2020, 21:21   

umiejead napisał/a:
Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim a As Date, t As Variant

On Error Resume Next
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
    If IsError(Application.Match(CLng(a), .Cells, 0) + 3) Then
        t = 5
    Else
        t = Application.Match(CLng(a), .Cells, 0) + 3
    End If
    MsgBox t
End With
 
End Sub


Dzieki wielkie, biore się za testy. :-)
_________________
canto
ID posta: 385037 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 06-04-2020, 17:18   

umiejead napisał/a:
Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim a As Date, t As Variant

On Error Resume Next
 
a = Cells(1, 8)

With Cells(4, 1).CurrentRegion.Columns(4)
    If IsError(Application.Match(CLng(a), .Cells, 0) + 3) Then
        t = 5
    Else
        t = Application.Match(CLng(a), .Cells, 0) + 3
    End If
    MsgBox t
End With
 
End Sub


Załączam mój plik, niby wszystko podobnie ale dla daty +1 coś mi tu błędnie pokazuje.

Kopia.xlsm
Pobierz Plik ściągnięto 9 raz(y) 17.26 KB

_________________
canto
ID posta: 385071 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2888 razy
Posty: 9578
Wysłany: 06-04-2020, 18:15   

NIE STOSUJ On Error Resume Next, JAK NIE UMIESZ SIĘ NIM POSŁUGIWAĆ! Lepsze jest wywalenie się kodu, bo przynajmniej wiesz, że coś jest nie halo (i wiesz, w którym miejscu trzeba coś naprawić), jak ignorowanie błędów i potencjalnie zwrócenie nieprawidłowego wyniku.

Kod:
    Dim a           As Date
    Dim t           As Long

    a = Cells(1, 8).Value

    With Cells(4, 1).CurrentRegion.Columns(4)
        'jl. szukana mniejsza od pierwszej dostępnej...
        If a < .Cells(2).Value Then
            '...zwróć nr wiersza pierwszej dostępnej
            t = .Cells(2).Row
       
        'jl. szukana zwraca błąd...
        ElseIf IsError(Application.Match(CLng(a), .Cells, 0)) Then
            '...jl.szukana większa od ostatniej dostępnej...
            If a > .Cells(.Cells.Count).Value Then
                '...zwróć nr wiersza ostatniej dostępnej
                t = .Cells(.Cells.Count).Row
            Else
                '...zwróć nr wiersza pierwszej dostępnej po szukanej
                t = Application.Match(CLng(a), .Cells, 1) + 1 + 3
            End If
       
        'nie ma błędu,...
        Else
            '... więc zwróć nr wiersza pierwszego wystąpienia szukanej
            t = Application.Match(CLng(a), .Cells, 0) + 3
        End If
    End With

    MsgBox t

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 385075 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 06-04-2020, 18:15   

canto napisał/a:


Załączam mój plik, niby wszystko podobnie ale dla daty +1 coś mi tu błędnie pokazuje.


Może to kwestia tego pliku i daty, dostaje je od paru osób i m.in. na tym właśnie źle liczy, przez co błędnie zaznacza mi zakres danych do kopiowania.
_________________
canto
ID posta: 385076 Skopiuj do schowka
 
 
Tajan


Pomógł: 4630 razy
Posty: 10245
Wysłany: 06-04-2020, 20:41   

Zapewne w tym plik nie masz dat, lecz teksty udające datę. Zmień format tych komórek na ogólny. W komórkach z datą powinna się pojawić liczba całkowita, w komórkach zawierających "nibydatę" nie zmieni się nic.
ID posta: 385086 Skopiuj do schowka
 
 
canto 
Exceloholic



Wersja: Win Office 2016
Posty: 246
Wysłany: 06-04-2020, 22:07   

Tajan napisał/a:
Zapewne w tym plik nie masz dat, lecz teksty udające datę. Zmień format tych komórek na ogólny. W komórkach z datą powinna się pojawić liczba całkowita, w komórkach zawierających "nibydatę" nie zmieni się nic.


To nie są "nibydaty", wychodzi na to że bolą go kolejne kolumny i podaje mi zły wynik.
Może źle zaznaczam te wyszukiwanie daty?
Dodaję załącznik.

aaa.xlsm
Pobierz Plik ściągnięto 17 raz(y) 22.98 KB

_________________
canto
ID posta: 385095 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2888 razy
Posty: 9578
Wysłany: 06-04-2020, 23:50   

canto napisał/a:
wychodzi na to że bolą go kolejne kolumny i podaje mi zły wynik.
Nie. Boli go brak zrozumienia otrzymanego kodu. Porównaj układ tabel w załączonych przez Ciebie plikach. Nie tyle chodzi o kolumny (choć w ostatnim pliku doszły nowe i w zasadzie to przez nie masz problem), a bardziej o wiersze. Zbadaj jaki zakres zwraca
Kod:
Cells(4, 1).CurrentRegion.Columns(4)
w ostatnim i poprzednim pliku. Jak zobaczysz różnicę, to pewnie będziesz już umiał zmodyfikować kod, by pasował do nowego układu tabeli.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 385109 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