[Excel] Porównanie kilku kolumn


(hoobert) #1

Witam, mam pytanie dotyczące kilku sklepów, których ceny są porównywane oraz wyświetlenia ich cen w odpowiednich komórkach.

Wygląda to następująco. Mam podane ceny 2 sklepów dotyczących wyceny 14 produktów.

Problem w tym że firma ABC podała cenę pierwszych 10 produktów

Arkusz1:

img1c.png

Natomiast firma 2 podała ceny 10 produktów z zakresu od 1-14

Arkusz2:

img2k.png

Teraz potrzebuję to posortować w ten sposób żeby wyświetlało mi w 1 wierszu nazwę produktu i ceny 1 firmy oraz ceny 2 firmy, coś na wzór:

Arkusz3:

img3n.png

A ostatecznie, żeby pokazało się takie porównanie:

Arkusz4:

img4ab.png

Mam nadzieję, że swój problem przedstawiłem wystarczająco jasno.

Czy takie rozwiązanie jest możliwe?

Z góry dziękuję za pomoc :slight_smile:

Pozdrawiam, hoobert


(Tomek Matz) #2

Wrzuć na jakiś serwer plik z przykładowymi danymi tak, żeby ktoś kto będzie chciał pomóc nie musiał tworzyć go ręcznie.

A jeśli chodzi o Twoje pytanie to bez makra się chyba nie obejdzie (choć być może da się to zrobić z użyciem tablic przestawnych). Pierwsze pytanie jakie się nasuwa to czy będą to tylko 2 sklepy, czy też może ich być więcej? Ja generalnie przygotowałbym funkcję, która pobierałaby zmienną liczbę parametrów. Te parametry to byłyby tablice składające się z nazw produktów i cen dla poszczególnych sklepów. Tak można przekazywać zmienną liczbę parametrów w VBA:

Public Function SortProducts(ParamArray params() As Variant)

.....

End Function

I przykładowe wywołanie dla pojedynczych komórek

=SortProducts(C4;D4;E4;F4)

(hoobert) #3

Tych sklepów może być więcej niż 2.

Plik z przykładem http://www.speedyshare.com/files/25001805/Przyk_ad1.xls


(Tomek Matz) #4

Przysiadłem i napisałem tą funkcję, o której mówiłem (a w zasadzie zestaw funkcji). Tak to wygląda w kodzie:

Public Function SortShopProducts(ParamArray params() As Variant) As Variant


Dim result() As Variant

Dim i, j, k, maxRows, maxColumns As Integer

Dim shops() As Range

Dim productNames() As String

Dim add As Boolean


ReDim shops(LBound(params) To UBound(params)) As Range

For i = LBound(params) To UBound(params)

    Set shops(i) = params(i)

Next i

Call BubbleSortRangeArray(shops)


ReDim productNames(0 To 0)

add = False

For i = LBound(shops) To UBound(shops)

    For j = 2 To shops(i).Rows.Count

        If Not StringExists(shops(i).Item(j, 1), productNames) Then

            If Not add Then

                add = True

            Else

                ReDim Preserve productNames(0 To UBound(productNames) + 1) As String

            End If


            productNames(UBound(productNames)) = shops(i).Item(j, 1)

        End If

    Next j

Next i


Call BubbleSortStringArray(productNames)


maxRows = UBound(productNames) + 2

maxColumns = UBound(shops) + 2

ReDim result(1 To maxRows, 1 To maxColumns)


result(1, 1) = shops(0).Item(1, 1)

For i = LBound(productNames) To UBound(productNames)

    result(i + 2, 1) = productNames(i)

Next i


For i = LBound(shops) To UBound(shops)

    result(1, i + 2) = shops(i).Item(1, 2)

    For j = LBound(productNames) To UBound(productNames)

        For k = 2 To shops(i).Rows.Count

            If StrComp(shops(i).Item(k, 1), productNames(j), vbTextCompare) = 0 Then

                result(j + 2, i + 2) = shops(i).Item(k, 2)

            End If

        Next k

    Next j

Next i


SortShopProducts = result

End Function


Public Function StringExists(s As String, sArr() As String) As Boolean

Dim i As Integer

Dim result As Boolean


result = False

For i = LBound(sArr) To UBound(sArr)

    If StrComp(sArr(i), s, vbTextCompare) = 0 Then result = True

Next i


StringExists = result

End Function


Public Sub BubbleSortStringArray(ByRef sArr() As String)


Dim i As Long, j As Long

Dim sTemp As String


For i = LBound(sArr) To UBound(sArr) - 1

    For j = i To UBound(sArr)

        If StrComp(sArr(i), sArr(j), vbTextCompare) = 1 Then

            sTemp = sArr(i)

            sArr(i) = sArr(j)

            sArr(j) = sTemp

        End If

    Next j

Next i


End Sub


Public Sub BubbleSortRangeArray(ByRef rArr() As Range)


Dim i As Long, j As Long

Dim rTemp As Range


For i = LBound(rArr) To UBound(rArr) - 1

    For j = i To UBound(rArr)

        If StrComp(rArr(i).Item(1, 2), rArr(j).Item(1, 2), vbTextCompare) = 1 Then

            Set rTemp = rArr(i)

            Set rArr(i) = rArr(j)

            Set rArr(j) = rTemp

        End If

    Next j

Next i


End Sub

Jak tego używać? W tym Twoim przykładowym skoroszycie robisz sobie np. nowy arkusz. W komórce A1 wstawiasz takie coś:

=SortShopProducts(Arkusz1!A1:B11;Arkusz2!A1:B12)

Potem zaznaczasz obszar 15x3 (na niebiesko) i wciskasz kombinację klawiszy Ctrl + Shift + Enter i gotowe. Wiersze z nazwami produktów oraz kolumny z nazwami sklepów są od razu posortowane alfabetycznie.

Dlaczego 15x3?

15 wierszy, bo jest 14 różnych produktów + wiersz z nagłówkiem

3 kolumny, bo są 2 sklepy + kolumna z nagłówkiem

Jeśli będzie więcej sklepów to po prostu po średnikach podajesz tabele z danymi dla tych sklepów. Oczywiście przy innej ilości sklepów i innej ilości produktów będziesz musiał zaznaczyć inny obszar. Generalnie lepiej zaznaczyć większy obszar niż się powinno aniżeli mniejszy :slight_smile: Jak zaznaczysz większy to po prostu w niektórych komórkach będziesz miał informację o błędzie, ale w pozostałych będą poprawne wartości.

Zaraz wrzucę przykładowy formularz.

Link: http://rapidshare.com/files/428742988/Przyk__ad1.xlsm

PS Konstruktywna krytyka mile widziana

Pozdrawiam,

-- Dodane 04.11.2010 (Cz) 12:33 --

Hm, niedokładnie opisałem jak to trzeba uruchomić ... Jeszcze raz :stuck_out_tongue:

Wstawiamy odpowiednią formułę do dowolnej komórki w dowolnym arkuszu (np. komórki A1 w arkuszu 4 jak wspomniałem wyżej).

Następnie zaznaczamy odpowiedni obszar (dla powyższego przykładu będzie to obszar 15x3).

Następnie klikamy myszką w miejscu, gdzie wstawiliśmy tą formułę i dopiero wtedy należy nacisnąć Ctrl + Shift + Enter.

Dołączam krótki filmik (nazwijmy to) instruktażowy http://rapidshare.com/files/428853972/przyklad.avi (plik ma niecały 1 MB)


(hoobert) #5

Dzięki za odpowiedź, jednak mam z tym problem.

Posiadam Excela w wersji 2007. Robię tak jak mówisz.

Włączam Excela, uruchamiam makra.

Twoja tabela działa poprawnie natomiast jak próbuje zrobić to samo to się nie udaje.

Wklejam w komórkę A20 w Arkuszu 5 formułę:

=SortShopProducts(Arkusz1!A1:B11;Arkusz2!A1:B12;Arkusz3!A1:B12)

Wyskakuje mi "Produkt"

Teraz zaznaczam obszar od komórki A20 do komórki D35

Klikam Ctrl + Shift + Enter i nic się nie dzieje.

Jeżeli kliknę tą komórkę, gdzie docelowo wkleiłem formułę, to odznaczy mi się zaznaczony obszar, po czym i tak Ctrl + Shift + Enter nic nie daje.

Zaznaczę jeszcze, że klikając na Twoją tabelę i kliknięciu Enter wyskakuje komunikat "Zmienna części tablicy nie jest możliwa".

Kombinacja klawiszy Ctrl + Shift + Enter pozwala mi wyjść z edycji tej funkcji.

Natomiast w mojej funkcji (mimo, że wygląda tak samo) po zaznaczeniu i kliknięciu Enter ten komunikat nie wyskakuje.

Czy może być to spowodowane wersją Offica 2007?


(Tomek Matz) #6

Ja też korzystam z wersji Office 2007. Przeczytaj to co niedawno dodałem. Na początku niedokładnie opisałem jak tego trzeba używać. Może teraz się uda.

Chodzi o to, żeby kliknąć w miejscu, gdzie wpisuje się formułę (w tym pasku formuły :P), wtedy obszar Ci się nie odznaczy. Widać to na filmiku, który załączyłem.


(hoobert) #7

Stary mistrzostwo :wink:

Klikałem Ctrl + Shift + Enter nie zaznaczając tej komórki w pasku gdzie wyświetla się ta funkcja, ale już wszystko działa elegancko :slight_smile:

Dzięki wielkie za pomoc i poświęcony czas - o to chodziło.


(Tomek Matz) #8

Nie ma sprawy. Jakbyś potrzebował zamiast wpisywanych 0 mieć pustą komórkę to wystarczy tą pętlę

For i = LBound(shops) To UBound(shops)

    result(1, i + 2) = shops(i).Item(1, 2)

    For j = LBound(productNames) To UBound(productNames)

        For k = 2 To shops(i).Rows.Count

            If StrComp(shops(i).Item(k, 1), productNames(j), vbTextCompare) = 0 Then

                result(j + 2, i + 2) = shops(i).Item(k, 2)

            End If

        Next k

    Next j

Next i

podmienić na taką

For i = LBound(shops) To UBound(shops)

    result(1, i + 2) = shops(i).Item(1, 2)

    For j = LBound(productNames) To UBound(productNames)

        result(j + 2, i + 2) = ""

        For k = 2 To shops(i).Rows.Count

            If StrComp(shops(i).Item(k, 1), productNames(j), vbTextCompare) = 0 Then

                result(j + 2, i + 2) = shops(i).Item(k, 2)

            End If

        Next k

    Next j

Next i