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
Przesunięty przez: Artik
28-02-2019, 00:12
makro wyszukujące najczęstsze rekordy
Autor Wiadomość
ezq
Starszy Forumowicz


Posty: 41
Wysłany: 11-03-2019, 20:57   

dzięki Marecki, działa , tylko jedynie muszę wpisywać datę ręcznie bo jak w komórce A1 jest formuła ZŁĄCZ.TEKSTY to wtedy makro wywala błąd, ale to nie problem , będe wpisywał date ręcznie.

ps, czy mógłbyś mi wkleić linijkę kodu który odpowiada za rozmieszczenie tabeli?, chciałbym ją obniżyć do np. wiersza 15 ale jak zmieniamn w kodzie
.[C2].CurrentRegion.Offset(1, 1).ClearContents na C15 to nic się nie dzieje, co powinienem zmienić?
ID posta: 363971 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1234 razy
Posty: 4296
Wysłany: 11-03-2019, 21:52   

ezq napisał/a:

jedyny minus to taki ,że nie może być żadnego wpisu poniżej tabeli w kolumnie c bo inaczej dane wpisuje w innym miejscu ale to nie problem.


ezq napisał/a:

ps, czy mógłbyś mi wkleić linijkę kodu który odpowiada za rozmieszczenie tabeli?, chciałbym ją obniżyć do np. wiersza 15 ale jak zmieniamn w kodzie
.[C2].CurrentRegion.Offset(1, 1).ClearContents na C15 to nic się nie dzieje, co powinienem zmienić?

Poniżej w tabeli w kolumnie c, D, E możesz mieć dowolne dane.

Skoro masz tabelę od C15 (C2) to wiadomo, że tylko obszar C16:E20 (C3:E7) zawiera poprzednie dane, które trzeba czyścić, i tylko w nim wstawimy wyniki. Po co więc zabawa w CurrentRegion (przy czyszczeniu) i .Range("C" & .Cells(Rows.Count, "C").End(3) (przy wstawieniu)?

Zmień
Kod:

With Sheets("Arkusz2")
   ...
End With

na
Kod:

With Worksheets("Arkusz2")
    .Range("C16").Resize(5, 3).ClearContents
    .Range("E16").Value = lst.Count
    For i = 0 To 4
        v = Split(lst.Item(i), "_")
        .Range("C16").Offset(i).Resize(1, 2).Value = Array(v(1), v(0))
    Next
End With
ID posta: 363976 Skopiuj do schowka
 
 
ezq
Starszy Forumowicz


Posty: 41
Wysłany: 13-03-2019, 09:37   

dzięki panowie działa, ale wyskoczył mi jeszcze jeden warunek :(
aby liczył tak jak teraz, tylko jedyną zmianą jest to że w Kolumnie E może być nie tylko słowo "TAK" ale też "MOZLIWE" , czyli:
aby liczyl wystopienia i rekordy jeżeli w kolumnie E jest "TAK" lub "MOZLIWE" a w kolumnie H jest data ">=" od daty w komórce A1

dzięki za pomoc i cierpliwość
ID posta: 364078 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1198 razy
Posty: 3548
Wysłany: 13-03-2019, 10:10   

Przetestuj.
Kod:
Sub MaxDuplikaty_kuma()
    Dim i As Long
    Dim d As Object, lst As Object
    Dim a(), k, v
    Dim ms As String
    Dim dcz
       
    dcz = Sheets("Arkusz2").Range("A1").Value
    Set d = CreateObject("scripting.dictionary")
    Set lst = CreateObject("System.Collections.ArrayList")
    With Sheets("Arkusz1")
        a = .Range("C2:H" & .Cells(Rows.Count, "C").End(3).Row).Value
    End With
    For i = 1 To UBound(a)
        ms = a(i, 1)
        If Len(ms) > 0 And (UCase(a(i, 3)) = "TAK" Or _
                UCase(a(i, 3)) = "MOZLIWE") And a(i, 6) >= dcz Then d(ms) = d(ms) + 1
    Next
    For Each k In d.keys
        lst.Add Format(d.Item(k), "00000") & "_" & k
    Next
    lst.Sort
    lst.Reverse
    Application.ScreenUpdating = False
    With Sheets("Arkusz2")
        .Range("C3:E7").ClearContents
        .[E3] = lst.Count
        For i = 0 To 4
            v = Split(lst.Item(i), "_")
            .Range("C" & .Cells(Rows.Count, "C").End(3).Row)(2).Resize(1, 2) = Array(v(1), v(0))
        Next
    End With
    Set d = Nothing
    Set lst = Nothing
End Sub
Pozdrawiam.
ID posta: 364086 Skopiuj do schowka
 
 
ezq
Starszy Forumowicz


Posty: 41
Wysłany: 15-03-2019, 07:57   

dzięki, super działa
ID posta: 364265 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