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: 74025 Skopiuj do schowka RowSource Combobox jako tabela przestawna
Autor Wiadomość
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 23-01-2023, 14:22   RowSource Combobox jako tabela przestawna

Witam,

Posiadam tabelę z różnymi danymi w której między innymi jest dzień, miesiąc i rok wykonania produkcji danego asortymentu w arkuszu "dane"

W poszczególnych miesiącach zostało wykonanych wiele detali i w comboboxie jak podam źródło "rowSource" na kolumnę miesiąc to mam zduplikowane wartości (np. styczeń występuje 25razy itd)

W związku z tym stworzyłem tabelę przestawną która filtruje miesiące i pokazuje tylko jeden wynik, ale nie wiem jak wskazać źródło RowSource dla tej tabeli przestawnej w comboboxie "miesiąc"

Bardzo prosze o pomoc ;-)
ID posta: 424461 Skopiuj do schowka
 
 
ple4
ExcelSpec


Wersja: Win Office 2003
Pomógł: 108 razy
Posty: 473
Wysłany: 24-01-2023, 01:47   

Z powieetrza wyczaruujem przyykład, czy z tweego pliiku ... maaster ? ... :->
ID posta: 424508 Skopiuj do schowka
 
 
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 24-01-2023, 08:09   

W załączniku plik- sorki zapomniałem dołączyć

Przykład.xlsm
Pobierz Plik ściągnięto 25 raz(y) 208.33 KB

ID posta: 424510 Skopiuj do schowka
 
 
master_mix 
Excel Expert



Wersja: Win Office 365
Pomógł: 1287 razy
Posty: 2620
Wysłany: 24-01-2023, 09:33   

LINK
_________________

Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie.
ID posta: 424513 Skopiuj do schowka
 
 
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 24-01-2023, 11:41   

Faktycznie, w podanym przykładzie fajnie to działa i mogłoby mieć zastosowanie w moim przypadku, ale chyba nie jestem aż tak biegły VBA żeby to zmienić na poczet swojego pliku.

Dodatkowo w momencie kiedy wpiszę taką samą nazwę Dostawcy to też jest ona zdublowana w combobox, a tego właśnie chcę uniknąć.

Chciałbym żeby w comboboxie aktualizowały się wartości z kolumny miesiąc ale nie były zdublowane
ID posta: 424540 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 24-01-2023, 15:17   

Na początku procedury "UserForm_Initialize" dodaj taki kod:
Kod:
   Me.cbMiesiac.RowSource = ""
   
   With Sheets("Dane do tabel").PivotTables("PivotMiesiąc")
        .PivotCache.Refresh
        Me.cbMiesiac.List = .PivotFields("Miesiąc").DataRange.Value
   End With
ID posta: 424566 Skopiuj do schowka
 
 
master_mix 
Excel Expert



Wersja: Win Office 365
Pomógł: 1287 razy
Posty: 2620
Wysłany: 24-01-2023, 22:39   

maaster napisał/a:
fajnie to działa i mogłoby mieć zastosowanie w moim przypadku, ale chyba nie jestem aż tak biegły VBA żeby to zmienić na poczet swojego pliku.


Można ten kod zamknąć w uniwersalną klasę i wykorzystać w dowolnym projekcie.
Dodałem też możliwość tworzenia unikatowej listy

klasa ComboBoxClass
Kod:
Option Explicit

'@master_mix,.    / 2023-01-24
'-----------------------------------------------------------------------
'*Klasa "ComboBoxClass"
' Lista z tablicy wartości, możliwe ustawienie Sortowania,
' Czy zawierać ma tylko unikaty
' ComboBox zawęża listę - filtruje - po fragmenvie wpisanej nazwy
' Poruszanie się kursorami góra-dół po liście
'-----------------------------------------------------------------------

'obsługuje kontrolkę ComboBox ActiveX
'Tworzenie instancji klasy w UserForm lub Arkuszu :
'***********************************************************************
''Zmienna dla nowej instancji klasy musi być na pozionie
'klasy Firmy lub Arkusza
'Dim cmbForm As ComboBoxClass
'Private Sub UserForm_Initialize()
'    'Tworzenie instancji klasy
'    Set cmbForm = New ComboBoxClass
'    'Przypisanie objektu ComboBox z UserForm do odbiornika w klasie
'    Set cmbForm.SetCombobox = Me.ComboBoxFormy
'    'Przypisanie listy wartości ComboBox
'    cmbRok.UpdateCmb ArrayLista, Ascending, True
'End Sub
'************************************************************************

''Jeżeli tworzymy więcej instancji klasy, użyjemy kolekcji
'Dim cmbColl As Collection
'
'Private Sub UserForm_Initialize()
'    Dim newClassCombo As ComboBoxClass
'
'    Set newClassCombo = New ComboBoxClass
'    Set newClassCombo.SetCombobox = Me.ComboBoxFormy_1
'    cmbColl.Add newClassCombo, "ComboBoxFormy_1"
'    cmbColl.UpdateCmb ArrayLista, Ascending, True
'
'    Set newClassCombo = New ComboBoxClass
'    Set newClassCombo.SetCombobox = Me.ComboBoxFormy_2
'    cmbColl.Add newClassCombo, "ComboBoxFormy_2"
'    cmbColl.UpdateCmb ArrayLista, Ascending, True
''itd
'End Sub


Public Enum SortOrder
    NoSorting = 0
    Ascending = 1
    Descending = 2
End Enum

Private WithEvents cmb As MSForms.ComboBox
Private cmbList() As Variant
Private bCancel As Boolean

Public Property Set SetCombobox(myCombo As MSForms.ComboBox)
    Set cmb = myCombo
End Property

Private Sub cmb_Change()
    If bCancel Then
        bCancel = False
    Else
        cmb.list = Filter(cmbList, cmb.Value, True, vbTextCompare)
        cmb.DropDown
    End If
End Sub

Private Sub cmb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    bCancel = (KeyCode = 38 Or KeyCode = 40)
End Sub

Public Sub UpdateCmb(rng As Range, Optional e_SortOrder As SortOrder = 0, Optional bDistinct As Boolean = False)
    cmb.MatchEntry = 2
    cmbList = ComboSortList(rng, e_SortOrder, bDistinct)
    cmb.list = cmbList
End Sub

Private Function ComboSortList(myArray, _
        Optional e_SortOrder As SortOrder = 0, _
        Optional bDistinct As Boolean = False) As Variant
    Dim el
    With CreateObject("ADODB.recordset")
        .Fields.Append "COLUMN_1", 201, 120
        .Open
        For Each el In myArray
            If bDistinct And .RecordCount > 0 Then
                .movefirst
                .Find "COLUMN_1" & " = '" & el & "'"
                If .EOF Then
                    .AddNew "COLUMN_1", el
                End If
            Else
                .AddNew "COLUMN_1", el
            End If
        Next
        If e_SortOrder > 0 Then .Sort = "COLUMN_1 " & IIf(e_SortOrder = 1, "ASC", "DESC")
        ComboSortList = Application.Index(.getrows, 0)
        .Close
    End With
End Function


Do Twojego pliku zaimplementowałem klasę tylko do formularza "Raport dla wszystkich"
Z implementacją do drugiego powinieneś sobie poradzić.

PrzykładCmb.xlsm
Pobierz Plik ściągnięto 24 raz(y) 227.45 KB

_________________

Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie.
ID posta: 424584 Skopiuj do schowka
 
 
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 25-01-2023, 10:44   

:clap

Bardzo dziękuję za pomoc :) z moimi umiejętnościami VBA nigdy bym tego nie ogarnął :)
ID posta: 424595 Skopiuj do schowka
 
 
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 25-01-2023, 11:30   

A powiedzcie mi proszę jeszcze gdzie tutaj robię błąd :-/

Chciałbym jeszcze założyć ostrzeżenie- gdyby ktoś chciał wygenerować raport dla miesiąca i roku dla którego nie ma danych i tym samym nie można wyfiltrować tabeli przestanej, żeby wyświetlił się message box

Kod:
Private Sub cbGenerujPDF_Click()

If cbMiesiac.Value = "" Or cbRok.Value = "" Or cbKrawcowa.Value = "" Then
       
    ' jeśli nie wypełnione wszystkie pola
       MsgBox "Wypełnij wszystkie pola", vbCritical, WERSJA
Else

 ' generowanie danych w tabeli przestawnej wg założonych filtrów krawcowa/miesiąc/rok
 
    Dim pivotTable As pivotTable
    Set pivotTable = wsKrawcowa.PivotTables("TabKrawcowa")

    Dim field As PivotField
    Set field = pivotTable.PivotFields("Miesiąc")

    Dim selectedValue As String
    selectedValue = cbMiesiac.Value
   
    Dim item As PivotItem
    Dim found As Boolean
    found = False


    For Each item In field.PivotItems
        If item.Value = selectedValue Then
            found = True
            Exit For
        End If
    Next
   
    If Not found Then
        MsgBox "Nie znaleziono filtru dla miesiąca: " & selectedValue & ". Proszę sprawdzić i ponowić operację.", vbExclamation, "Ostrzeżenie"
        Exit Sub
    Else
        field.CurrentPage = selectedValue
    End If
End If


stworzyłem coś takiego, ale nawet jak są dane dla danego miesiąca i roku to i tak jest message box, więc nie bardzo to działa tak jak należy
ID posta: 424598 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 25-01-2023, 13:49   

Teoretyczne kod jest poprawny, więc trudno powiedzieć jaka może być przyczyna. Może spróbuj zamienić:
Kod:
  For Each item In field.PivotItems
        If item.Value = selectedValue Then
            found = True
            Exit For
        End If
    Next

na:
Kod:
    On Error Resume Next
       found = Not IsNull(field.PivotItems(selectedValue))
    On Error GoTo 0
i sprawdź czy to coś zmieni.

PS. Nie nadawaj dla zmiennych nazw będących nazwami typów danych, jak w tym przypadku:
Kod:
 Dim pivotTable As pivotTable

bo to jest proszenie się o kłopoty :-) Wprawdzie działa, ale nie wiadomo jak długo :-)
ID posta: 424604 Skopiuj do schowka
 
 
maaster
Forumowicz


Wersja: Win Office 2016
Posty: 18
Wysłany: 26-01-2023, 08:00   

Cytat:
PS. Nie nadawaj dla zmiennych nazw będących nazwami typów danych, jak w tym przypadku:
Kod:
Dim pivotTable As pivotTable

bo to jest proszenie się o kłopoty :-) Wprawdzie działa, ale nie wiadomo jak długo :-)


Faktycznie to jest bez sensu- dzięki za radę i pomoc :)
ID posta: 424625 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.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