ID tematu: 74025
 |
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
|
|
|
 |
|
|
|
|
ple4
Stały bywalec Excelforum
Wersja: Win Office 2003
Pomógł: 68 razy
Posty: 311
|
| Wysłany: 24-01-2023, 01:47
|
|
|
Z powieetrza wyczaruujem przyykład, czy z tweego pliiku ... maaster ? ...  |
|
 | ID posta:
424508
|
|
|
|
|
|
|
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 11 raz(y) 208.33 KB |
|
|
| ID posta:
424510
|
|
|
|
|
|
master_mix 
Excel Expert
Wersja: Win Office 365
Pomógł: 1216 razy
Posty: 2319
|
| 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
|
|
|
|
|
|
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
|
|
|
|
|
|
Tajan
Pomógł: 5234 razy
Posty: 11412
|
| 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
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1216 razy
Posty: 2319
|
| 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 10 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
|
|
|
|
|
|
maaster
Forumowicz
Wersja: Win Office 2016
Posty: 18
|
| Wysłany: 25-01-2023, 10:44
|
|
|
Bardzo dziękuję za pomoc :) z moimi umiejętnościami VBA nigdy bym tego nie ogarnął :) |
|
| ID posta:
424595
|
|
|
|
|
|
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
|
|
|
|
|
|
Tajan
Pomógł: 5234 razy
Posty: 11412
|
| 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
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
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
|
|
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
|
Regulamin
