Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Excel - filtrowanie unikatowych treści z kilku arkuszy do innego arkusza

bartekskon 24 Wrz 2014 13:50 1293 6
  • #1 24 Wrz 2014 13:50
    bartekskon
    Poziom 2  

    Witam.
    Mam następujący problem i niestety nie umiem sobie z nim poradzić.
    Muszę zrobić zestawienie danych z kilku arkuszy do innego arkusza np. "zestawienie. W arkuszu "zestawienie" mają pojawić się unikatowe (przefiltrowane) frazy z wszystkich zaznaczonych komórek, w kilku arkuszach, w jednym skoroszycie. Dodatkowo w rubryce obok powinna pojawić się liczba, ile razy dany wyraz się powtórzył.
    Dodam, że uzyskałem taki wynik i nie było to trudne jeśli chodzi o jeden arkusz, poprzez zastosowanie filtrowania zaawansowanego oraz formuły LICZ.JEŻELI
    Dziękuję

    0 6
  • #2 24 Wrz 2014 19:50
    JRV
    Specjalista - VBA, Excel

    bartekskon napisał:
    frazy z wszystkich zaznaczonych komórek, w kilku arkuszach

    Jaky sposób ich zaznaczenia w różnych arkuszach?
    W arkuszu "zestawienie" w jakiej kolumnie?

    0
  • #3 24 Wrz 2014 21:02
    bartekskon
    Poziom 2  

    np. z jednej kolumny w arkuszu 1 oraz jednej kolumny w arkuszu 2 zrobić wynik filtru w 3 arkuszu, obojętne w której kolumnie.
    Ważne żeby wyświetlana była tylko raz wartość która się powtarza zarówno w pierwszym oraz drugim arkuszu. Na koniec w kolumnie obok wyników, żeby była liczba ile razy dany wyraz był w tamtych kolumnach.

    0
  • #4 24 Wrz 2014 21:28
    JRV
    Specjalista - VBA, Excel

    bartekskon napisał:
    np. z jednej kolumny

    np. Wszystkie arkusze z wyjątkiem 'zestawienie' z kolumny A:
    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #5 25 Wrz 2014 09:01
    bartekskon
    Poziom 2  

    Witam.
    Super działa, bardzo dziękuje.
    Mam tylko jeszcze małą prośbę (myślałem, że sam do tego dojdę, ale niestety nie wychodzi mi to) muszę doprecyzować kolumny. Powiedziałem, że kolumny są obojętne, ale to nie jest do końca prawda. Wyniki mogą być wyświetlane w arkuszu zestawienie w kolumnie A, ponieważ jest on pustym arkuszem, ale zakres danych w zależności od dokumentu się zmienia. Nieraz we wszystkich arkuszach są to kolumny C i D nieraz inne. Ale wolałbym (jakby była taka możliwość oczywiście) żeby mi Pan wytłumaczył a nie dawał gotowe rozwiązanie (ewentualnie to i to ;)
    Jeszcze jedno pytanie, pierwszy oraz drugi wiersz jest scalony, ale dokument jest ograniczony, przez co zakres musiałby być od C5 i D5 do końca arkuszu, raz są to komórki C70, D70 a nieraz C90,D90.

    0
  • #6 25 Wrz 2014 19:22
    JRV
    Specjalista - VBA, Excel

    Jak pan myśli, że jak można zaprogramować nie widząc ile tych arkuszy, na które jednej lub drugiej kolumnie?

    bartekskon napisał:
    Nieraz we wszystkich arkuszach są to kolumny C i D nieraz inne

    Można powiedzieć, jak to wytłumaczyć do programu Excel?

    0
  • #7 26 Wrz 2014 18:13
    bartekskon
    Poziom 2  

    Dzięki.
    Problem rozwiązany dzięki pomocy kolegi (pozostało tylko usunąć zliczanie pustych komórek) przy zastosowaniu takiego oto kodu:

    Sub copyUniqueWordsToNewSheet()
    Dim outputColumn As Range, cellsInCurrentColumn As Range
    Dim numberOfColumnsInCurrentSheet As Integer, currentColumn As Integer
    Set outputColumn = ThisWorkbook.Sheets("zestawienie").Columns("A").Cells
    Set wordsToOccurenceMap = CreateObject("scripting.dictionary")
    For Each currentSheet In ThisWorkbook.Sheets
    If currentSheet.Name <> outputColumn.Parent.Name Then
    With currentSheet.UsedRange
    numberOfColumnsInCurrentSheet = .Columns.Count
    End With
    For currentColumn = 1 To numberOfColumnsInCurrentSheet
    lastNonBlankRowInCurrentColumn = currentSheet.Cells(Rows.Count, currentColumn).End(xlUp).Row
    Set cellsInCurrentColumn = Range(currentSheet.Cells(1, currentColumn), currentSheet.Cells(lastNonBlankRowInCurrentColumn, currentColumn))
    For Each currentCell In cellsInCurrentColumn
    word = currentCell
    If Not wordsToOccurenceMap.exists(word) Then
    wordsToOccurenceMap(word) = 1
    Else
    wordsToOccurenceMap(word) = wordsToOccurenceMap(word) + 1
    End If
    Next
    Next currentColumn
    End If
    Next

    outputColumn.Resize(Rows.Count, 2).ClearContents
    For Each uniqueWord In wordsToOccurenceMap
    outputRow = outputRow + 1
    outputColumn(outputRow) = uniqueWord
    outputColumn(outputRow).Offset(, 1) = wordsToOccurenceMap(uniqueWord)
    Next
    End Sub

    0
  Szukaj w 5mln produktów