FAQ  Regulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj  Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ Strona Główna » Główna kategoria forum » Mam problem z makrem » Filtrowanie w zakresie dat. Idź do strony: 1 2   »  Poprzedni temat «» Następny temat ID tematu: 73943 Filtrowanie w zakresie dat. Autor Wiadomość jarekkk Exceloholic Posty: 217 Wysłany: 09-01-2023, 14:43   Filtrowanie w zakresie dat. Witam, Potrzebowałbym edytować poniższy kod tak, aby było możliwe również filtrowanie po kol. Data w zakresie wskazanych w tbxFiltr031 oraz tbxFiltr032 dat. Zaangażowanym dziękuję za podjęcie tematu. Pozdrawiam Jarek Kod: Private Sub FilterCustomers()   Dim towar As String   Dim tekst As String   Dim kraj As String 'Dim datod 'Dim datdo     Dim conditions As Object   Set conditions = CreateObject("Scripting.Dictionary")       towar = Trim(tbxFiltr001.Text)   tekst = Trim(tbxFiltr005.Text)   kraj = Trim(tbxFiltr006.Text) 'datod = Trim(tbxFiltr031.Text)           'Filtrowanoe kol o nazwie Data 'datdo = Trim(tbxFiltr032.Text)           'Filtrowanoe kol o nazwie Data     With conditions       If Len(towar) > 0 Then .Add Key:=.Count, Item:="Towar LIKE '%" & towar & "%'"     If Len(tekst) > 0 Then .Add Key:=.Count, Item:="Tekst LIKE '%" & tekst & "%'"     If Len(kraj) > 0 Then .Add Key:=.Count, Item:="Kraj LIKE '%" & kraj & "%'"         'Tu kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo       End With     ListBox1.Column = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData End Sub ID posta: 423962 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 09-01-2023, 16:02    Z jakiej bazy korzystasz? Jest to istotne gdyż formaty wartości dat użyte w zapytaniu SQL nieco różnią się od siebie zależności od bazy do której się odwołują i w związku z tym teksty, którymi są wartości textbox'ów, należy przekształcić w teksty w odpowiednim formacie. Przykładowo: Kod: 'Tu kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo     datod = Trim(tbxFiltr031.Text)     datdo = Trim(tbxFiltr032.Text)         If Len(datod) > 0 And Len(datdo) > 0 Then                datod = "'" & Format(CDate(datod), "yyyy/mm/dd") & "'"        datdo = "'" & Format(CDate(datdo), "yyyy/mm/dd") & "'" '       lub, np. '       datod = "#" & Format(CDate(datod), "m/d/yyyy") & "#" '       datdo = "#" & Format(CDate(datdo), "m/d/yyyy") & "#"               .Add Key:=.Count, Item:="WHERE Data BETWEEN " & datod & " AND " & datdo         End If ID posta: 423964 jarekkk Exceloholic Posty: 217 Wysłany: 10-01-2023, 10:22    Cześć Tajan, Za bazę wykorzystuję arkusz Excel, w którym zamieszczone są makra. Zmodyfikowałem ten kod, ale niestety gdzieś popełniłem błąd bo nie działa. Czy mogę prosić o pomoc? Pozdrawiam Jarek. Kod: Private Sub FilterCustomers()   Dim towar As String   Dim tekst As String   Dim kraj As String   Dim datod As String   Dim datdo As String     Dim conditions As Object   Set conditions = CreateObject("Scripting.Dictionary")       towar = Trim(tbxFiltr001.Text)   tekst = Trim(tbxFiltr005.Text)   kraj = Trim(tbxFiltr006.Text)   datod = Trim(tbxFiltr031.Text)           'Filtrowanoe kol o nazwie Data   datdo = Trim(tbxFiltr032.Text)           'Filtrowanoe kol o nazwie Data     With conditions       If Len(towar) > 0 Then .Add Key:=.Count, Item:="Towar LIKE '%" & towar & "%'"     If Len(tekst) > 0 Then .Add Key:=.Count, Item:="Tekst LIKE '%" & tekst & "%'"     If Len(kraj) > 0 Then .Add Key:=.Count, Item:="Kraj LIKE '%" & kraj & "%'"            ' kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo     'Tu kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo             'datod = Trim(tbxFiltr031.Text)            'datdo = Trim(tbxFiltr032.Text)         If Len(datod) > 0 And Len(datdo) > 0 Then                      datod = "'" & Format(CDate(datod), "yyyy/mm/dd") & "'"        datdo = "'" & Format(CDate(datdo), "yyyy/mm/dd") & "'" '       lub, np. '       datod = "#" & Format(CDate(datod), "m/d/yyyy") & "#"  '      datdo = "#" & Format(CDate(datdo), "m/d/yyyy") & "#"               .Add Key:=.Count, Item:="WHERE Data BETWEEN " & datod & " AND " & datdo         End If   End With     ListBox1.Column = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData End Sub ID posta: 423996 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 10-01-2023, 11:17    Co to znaczy "nie działa"? Brak wyników, błąd wykonania? Testowałeś oba sposoby przekazania daty? Czy data w textbox'ach jest wprowadzana zgodnie z ustawieniami regionalnymi systemu? W sumie, bez przykładowego pliku trudno będzie znaleźć przyczynę problemu. Możesz przynajmniej pokazać jak wygląda kod klasy "mCustomers"? ID posta: 423998 jarekkk Exceloholic Posty: 217 Wysłany: 10-01-2023, 12:46    Oczywiście, Poniżej kod klasy Kod: Option Explicit Private rs As Object Public Function GetRs() As Object   Set GetRs = rs End Function Public Function GetData() As Variant   If rs.RecordCount = 0 Then GetData = Array(): Exit Function   rs.MoveFirst   GetData = rs.GetRows End Function Public Function Filter(where As String) As Customers   rs.Filter = where   Set Filter = Me End Function Public Function Sort(criteria As String) As Customers   rs.Sort = criteria   Set Sort = Me End Function Public Function FillRs(ByRef tbl As ListObject) As Customers   Dim i As Long   Dim tblData() As Variant   Dim idCol As Long, towarCol As String, tekstCol As String, krajCol As String     Dim datCol As Date, cenaCol As Long, iloscCol As Long   If tbl.ListRows.Count = 0 Then GoTo exit_f   tblData = tbl.DataBodyRange.Value       idCol = FindColumnInTable("ID", tbl)   towarCol = FindColumnInTable("Towar", tbl)   datCol = FindColumnInTable("Data", tbl)   cenaCol = FindColumnInTable("Cena", tbl)   iloscCol = FindColumnInTable("Ilość", tbl)   tekstCol = FindColumnInTable("Tekst", tbl)   krajCol = FindColumnInTable("Kraj", tbl)     With rs     For i = 1 To UBound(tblData, 1)       .AddNew             .Fields("ID").Value = tblData(i, idCol)       .Fields("Towar").Value = tblData(i, towarCol)         '.Fields("Data").Value = Format(tblData(i, datCol), "yyyy-mm-dd")       .Fields("Data").Value = Format(tblData(i, datCol), "dd.mm.yyyy")       .Fields("Cena").Value = tblData(i, cenaCol)       .Fields("Ilość").Value = tblData(i, iloscCol)       .Fields("Tekst").Value = tblData(i, tekstCol)       .Fields("Kraj").Value = tblData(i, krajCol)             .Update     Next         .MoveFirst   End With   exit_f:   Set FillRs = Me End Function Private Sub Class_Initialize()   Set rs = CreateObject("ADODB.Recordset")   SetupRs End Sub Private Sub SetupRs() 'Dim Z As Variant   With rs     'Z = ThisWorkbook.Worksheets("Arkusz1").Range("K1").Text       '.Fields.Append "ID", xAdInteger     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("K8").Text), xAdInteger     '.Fields.Append "Towar", xAdVarChar, 30     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("L8").Text), xAdVarChar, 50     '.Fields.Append "Data", xAdVarChar, 30     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("M8").Text), xAdVarChar, 50     '.Fields.Append "Cena", xAdVarChar, 20     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("N8").Text), xAdVarChar, 50     '.Fields.Append "Ilość", xAdVarChar, 20     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("O8").Text), xAdVarChar, 50     '.Fields.Append "Tekst", xAdVarChar, 50     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("P8").Text), xAdVarChar, 50     '.Fields.Append "Kraj", xAdVarChar, 12     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("Q8").Text), xAdVarChar, 50         .CursorLocation = xAdUseClient     .CursorType = xAdOpenStatic     .Open   End With End Sub Przy wprowadzeniu w TextBox'ach dat w formacie dd.mm.yyyy i poniższym kodzie (edytowany jak niżej) wyrzuca błąd 3001 - Argumenty są niewłaściwego typu, wykraczają poza dopuszczalny zakres lub są ze sobą w konflikcie, i skazuje na błąd w ostatniej linii poniższego kodu. Kod: Private Sub FilterCustomers() 'szybkie wyszukiwanie   Dim towar As String   Dim tekst As String   Dim kraj As String   Dim datod As String   Dim datdo As String     Dim conditions As Object   Set conditions = CreateObject("Scripting.Dictionary")       towar = Trim(tbxFiltr001.Text)   tekst = Trim(tbxFiltr005.Text)   kraj = Trim(tbxFiltr006.Text)   datod = Trim(tbxFiltr031.Text)           'Filtrowanoe kol o nazwie Data   datdo = Trim(tbxFiltr032.Text)           'Filtrowanoe kol o nazwie Data     With conditions       If Len(towar) > 0 Then .Add Key:=.Count, Item:="Towar LIKE '%" & towar & "%'"     If Len(tekst) > 0 Then .Add Key:=.Count, Item:="Tekst LIKE '%" & tekst & "%'"     If Len(kraj) > 0 Then .Add Key:=.Count, Item:="Kraj LIKE '%" & kraj & "%'"            ' kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo     'Tu kod do filtrowania kol o nazwie Data w zakresie dat od datod  do datdo     'datod = Trim(tbxFiltr031.Text)     'datdo = Trim(tbxFiltr032.Text)         If Len(datod) > 0 And Len(datdo) > 0 Then                  'datod = "'" & Format(CDate(datod), "yyyy/mm/dd") & "'"          'datdo = "'" & Format(CDate(datdo), "yyyy/mm/dd") & "'"        datod = "'" & Format(CDate(datod), "dd.mm.yyyy") & "'"        datdo = "'" & Format(CDate(datdo), "dd.mm.yyyy") & "'" '       lub, np.          'datod = "#" & Format(CDate(datod), "m/d/yyyy") & "#"          'datdo = "#" & Format(CDate(datdo), "m/d/yyyy") & "#"          'datod = "#" & Format(CDate(datod), "dd.mm.yyyy") & "#"          'datdo = "#" & Format(CDate(datdo), "dd.mm.yyyy") & "#"               .Add Key:=.Count, Item:="WHERE Data BETWEEN " & datod & " AND " & datdo         End If   End With     ListBox1.Column = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData End Sub ID posta: 424003 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 10-01-2023, 15:27    Tak jak pisałem, bez przykładowego pliku to trochę strzelanie w ciemno. Ale spróbujmy... Przede wszystkim tworzone pole "Data" obiektu recordset'u klasy "mCustomers" nie jest typu daty lecz tekstowe i z tego względu linię: Kod: .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("M8").Text), xAdVarChar, 50 należałoby zamienić na: Kod: .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("M8").Text), vbDate Przy czym, zakładam że w arkuszu, w kolumnie "M" masz daty a nie teksty. Ponadto, z uwagi na to, że do wybierania rekordów używasz właściwości Filter gdzie nie można stosować BETWEEN, to kod kryterium powinien wyglądać tak: Kod:          datod = "#" & Format(CDate(datod), "dd/mm/yyyy") & "#"          datdo = "#" & Format(CDate(datdo), "dd/mm/yyyy") & "#"       .Add Key:=.Count, Item:="Data >= " & datod & " AND Data <= " & datdo ID posta: 424012 jarekkk Exceloholic Posty: 217 Wysłany: 10-01-2023, 18:52    Tajan, Cytat: Tak jak pisałem, bez przykładowego pliku to trochę strzelanie w ciemno. Ale spróbujmy... ... i to był strzał w 10-tke Fantastyczna praca! Jest ok. Po raz kolejny WIELKIE, WIELKIE DZIĘKI MISTRZU! Mam jeszcze jedno pytanie. Obecnie po wprowadzeniu każdej zmiany w TextBox'ach (Change) uruchamia się filtrowanie i zawęża zakres wyszukiwanych danych w ListBox. Co należy zrobić, aby dopiero po wprowadzeniu danych do TextBox'ów uruchamiać filtrowanie za pomocą CommandButton? Poniższa próba nie powiodła sie. Kod: Private Sub CommandButton7_Click() FilterCustomers End Sub Pozdrawiam Jarek. ID posta: 424023 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 10-01-2023, 19:24    Zatem usuń wywołanie "FilterCustomers" w procedurach Change TextBox'ów i pozostaw tylko w CommandButton7_Click. ID posta: 424026 jarekkk Exceloholic Posty: 217 Wysłany: 10-01-2023, 21:31    Tajan, Oczywiście działa Dzięki Tu jednak miałem dodatkową przeszkodę w poniższym kodzie: Kod: Private Sub objCmdButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _                                    ByVal X As Single, ByVal Y As Single) Dim vbButtonStandard, lastColumn, g                                     lastColumn = Sheets("Arkusz1").Cells(3, Columns.Count).End(xlToLeft).Column                                 For g = 12 To lastColumn                                                         If Sheets("Arkusz1").Cells(3, g) >= UserForm1.Frame1.ActiveControl.TabIndex Then         Sheets("Arkusz1").Cells(4, g) = Sheets("Arkusz1").Cells(5, g) ' = Sheets("Arkusz1").Cells(5, j - 1) + Sheets("Arkusz1").Cells(3, j - 1) '+ (Sheets("Arkusz1").Cells(5, j - 1) - Sheets("Arkusz1").Cells(4, j - 1))         Sheets("Arkusz1").Cells(6, g) = Sheets("Arkusz1").Cells(7, g)         'objCmdButton.BackColor = &H8000000F     End If     Next g                                       If objCmdButton.Width - 20 < X And Button = 1 Then             UserForm1.TextBox1.SetFocus ' = False             End If     End Sub Poniższa linia zdaje się na to nie pozwalała. Kod: UserForm1.TextBox1.SetFocus ' = False Mam jeszcze jedno pytanie. Data w Listbox prezentowana jest w formacie m/d/yyyyy. To pewnie za sprawą poniższej zmiany w klasie. Czy można zmienić kod tak, aby prezentowana była w formacie dd.mm.yyyy? Kod: .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("M8").Text), vbDate Pozdrawiam Jarek. ID posta: 424031 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 10-01-2023, 23:24    No, niestety... Trzeba łatać Tak, to za sprawą tej zmiany. Wartość daty jest teraz typu Data i Excel, przy dodawaniu jej do ListBox'a, nadaje format amerykański. Zadeklaruj na początku : Kod: Dim i As Long, xVal i w miejsce: Kod:  ListBox1.Column = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData wstaw: Kod: xVal = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData For i = 0 to UBound(xVal, 2)      xVal(2, i) = Format(xVal(2, i), "dd.mm.yyyy") Next  ListBox1.Column = xVal ID posta: 424047 jarekkk Exceloholic Posty: 217 Wysłany: 10-01-2023, 23:55    Tajan, J E S T E Ś W I E L K I ! Działa kapitalnie. O to chodziło Jeszcze raz WIELKIE DZIĘKI Pozdrawiam Jarek ID posta: 424052 jarekkk Exceloholic Posty: 217 Wysłany: 20-01-2023, 07:57    Witam ponownie, Mam jeszcze jedno pytanie. W sytuacji, gdy na podstawie TextBox filtrowanie nie odnajdzie wierszy w ListBox (ListBox jest pusty) wyskakuje błąd "Run - timer error 9: Subscript out of range" ze wskazaniem na pierwszą linię poniższej pętli. Poszukuję rozwiązania mojego problemu. Zaangażowanym z góry dziękuję. Kod: For i = 0 To UBound(xVal, 2)      xVal(2, i) = Format(xVal(2, i), "dd.mm.yyyy") Next Pozdrawiam Jarek. ID posta: 424373 Tajan Pomógł: 5234 razy Posty: 11414 Wysłany: 20-01-2023, 09:42    Spróbuj ten fragment: Kod: xVal = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData For i = 0 to UBound(xVal, 2)      xVal(2, i) = Format(xVal(2, i), "dd.mm.yyyy") Next  ListBox1.Column = xVal zmienić tak: Kod: xVal = mCustomers.Filter(Join(conditions.Items(), " AND ")).GetData If UBound(xVal) > -1 Then     For i = 0 to UBound(xVal, 2)          xVal(2, i) = Format(xVal(2, i), "dd.mm.yyyy")     Next     ListBox1.Column = xVal Else     ListBox1.Clear End If ID posta: 424374 jarekkk Exceloholic Posty: 217 Wysłany: 20-01-2023, 09:58    Cześć Tajan, Oczywiście działa niezawodnie WIELKIE DZIĘKI TAJAN Pozdrawiam Jarek ID posta: 424376 jarekkk Exceloholic Posty: 217 Wysłany: 09-02-2023, 11:59    Witam ponownie, Pracując nad filtrowaniem napotkałem na kolejną przeszkodę, z którą nie wiem jak sobie poradzić. W sytuacji, gdy kolejność kolumn wskazana w Arkusz1 (poniżej część kodu z klasy) pokrywa się z kolejnością kol. w klasie lub podmieniane kol. maja ten sam typ danych wszystko działa poprawnie. Kod: '.Fields.Append "Data", xAdVarChar, 30     .Fields.Append (ThisWorkbook.Worksheets("Arkusz1").Range("M8").Text), vbDate Problem następuje wtedy, gdy chcę zmienić kolejność wyświetlania kolumn w ListBox w taki sposób, gdy np. w klasie kol. 2 ma typ data (vbDate) a ja wywołam ją w kol.3 (wpisując w ("Arkusz1").Range("M8") nazwę kol. "Data"). Problemu nie ma, jeśli podmieniam kol. tego samego typu. Czy da się to jakoś rozwiązać np. wpisując logicznie pod komórką z nazwą "Data" typ vbDate, (może w ("Arkusz1").Range("M9")), i jakoś sie do tego odwołać lub w inny sposób? W sytuacji, gdy mamy błąd wyskakuje komunikat: RUN-TIME ERROR '-2147217887(80040e21)': Wielokrokowa operacja wygenerowała błędy. Sprawdź wszystkie wartości stanu. i wskazuje na błąd w Private Sub UserForm_Activate() w linii: Kod: xVal = mCustomers.FillRs(Arkusz1.ListObjects("tblCustomers")).GetData Podejmującym temat dziękuje za zaangażowanie. Pozdrawiam Jarek ID posta: 425238 Wyświetl posty z ostatnich: Wszystkie Posty15 Minut30 Minut1 Godziny2 Godzin6 Godzin12 Godzin1 Dzień2 Dni3 Dni4 Dni5 Dni6 Dni7 Dni2 Tygodnie1 Miesiąc3 Miesiące6 Miesięcy1 Rok Najpierw StarszeNajpierw Nowsze  Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ Strona Główna » Główna kategoria forum » Mam problem z makrem » Filtrowanie w zakresie dat. Idź do strony: 1 2   »  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: Wybierz forumExcel Forum - Porady, Pomoc, Excel Help, Excel FAQ Strona Główna|--Ogłoszenia|   |--Ważne informacje|--Główna kategoria forum|   |--FAQ - Najczęściej zadawane pytania|   |--Mam problem z formułą|   |--Mam problem z makrem|   |--Tabele przestawne, Power: Pivot, Query, View, Map|   |--Mam problem z wykresem|   |--Jak to zrobić?|   |--Współpraca Excel a inne aplikacje pakietu Office|   |--Zadania z Excela|   |--Google Sheets|   |--Interfejs wstążki MS Office|   |--Konkursy, zagadki, pomysły|   |--Tematy Ogólne|--Problemy dotyczące działania forum  Powered by phpBB modified by Przemo © 2003 phpBB Group Theme xandgreen created by spleen& Programosy modified v0.3 by warna Opieka techniczna www.wip.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