Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Tworzenie tabeli z pominięciem powtarzających wyrażeń

ma190 · Świeżak Wersja: Win Office 2010 Posty: 2

Dzień dobry!

Zastanawiam się czy jest możliwe, a w zasadzie w jaki sposób stworzyć automatycznie generująca się tabele która:

-Przejrzy dane z konkretnej kolumny
-Stworzy tabele uwzględniając w niej tylko niepowtarzające się wyrazy

Przykładowo mam w kolumnie następujące wyrazy:

Jabłka
Gruszki
Pomarańcze
Gruszki
Ananasy

i po zaznaczeniu tych komórek stworzy się tabela która będzie zawierać:

Jabłka
Gruszki
Pomarańcze
Ananasy

( Zdublowane gruszki zostają pominięte bo występują 2 razy, a chodzi mi o unikatowe frazy w tej tabeli - bez powtórek)

hurgadion · Wysłany: 10-10-2024, 14:17

Hej,
przetestuj makro w załączniku:

Kod:

Sub Unikalne()
Dim ost&

ost = Cells(Rows.Count, 1).End(xlUp).Row
Range("C:C").ClearContents
Range("A1:A" & ost).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
End Sub

Makro jest podpięte pod przycisk. Pozdrawiam :lol:

unik.sol.xlsm

Pobierz Plik ściągnięto 10 raz(y) 27.54 KB

ma190 · Świeżak Wersja: Win Office 2010 Posty: 2

Super - działa o to chodziło. Dziękuję :-)

Zastanawiam się jeszcze czy idzie tu wrzucić filtr który przy okazji mógłby pomijać wyrazy z ciągu.

np:

Owoce-Jabłka
Owoce-Gruszki
Owoce-Pomarańcze
Owoce-Gruszki
Owoce-Ananasy
Warzywa-Marchewki
Warzywa-Dynie

i w związku z tym że chce np. tylko owoce, bez tych powtarzających się to pewnie musiałby być dodatkowy warunek który pomija wyrazy zaczynajcie się na "Warzywa"

Czy idzie to w jakiś sposób zrobić?

hurgadion · Wysłany: 11-10-2024, 10:03

Hej,
może takim makrem:

Kod:

Sub Unikalne_bez_warzyw()
Dim ost&, tbl, TblK

ost = Cells(Rows.Count, 1).End(xlUp).Row
tbl = Range("A2:A" & ost).Value
Set TblK = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = LBound(tbl) To UBound(tbl)
If tbl(i, 1) Like "owoce*" Then TblK.Add tbl(i, 1), 1
Next i
On Error GoTo 0

Range("C:C").ClearContents
Range("C1").Value = "owoce"
Cells(2, 3).Resize(TblK.Count) = Application.Transpose(TblK.keys)
End Sub

Przetestuj w załaczniku jak to działa, pozdrawiam :lol:

unik.owoce.dict.xlsm

Pobierz Plik ściągnięto 11 raz(y) 27.78 KB