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, makro sumowanie komórek

qurek80 27 Paź 2009 15:01 12047 22
  • #1 27 Paź 2009 15:01
    qurek80
    Poziom 9  

    Mam problem. W arkuszu kalkulacyjnym mam kolumne z danymi (nr klienta), potem jest kolumny mało istotne, w 7 kolumnie jest wpisana ilosc godzin poswiecona na danego klienta. Chodzi mi o makro, ktore po pierwsze wylisotwaloby w kolumnie dajmny na to M wszystkich klientow (tzn posortuje i usunie powtarzajace sie numery) a w kolumnie N wypisze ile godzin zostalo poświeconych danemu klientowi lacznie. Probowalem korzystac z paru makr na tym forum, ale niestety moje umiejetnosci programistyczne powoduja, ze przy wiekszych probach modyfikacji wszystko sie wysypuje.
    Pomozcie prosze sie mi uporac z tym problemem. Z gory dziekuje za wszelka pomoc.

    0 22
  • #2 27 Paź 2009 15:57
    marcinj12
    Poziom 40  

    Witam,

    Może odpowiada Ci takie rozwiązanie: potraktować plik Excela jako "bazę danych", połączyć się samemu ze sobą i zapytaniem SQL wybrać interesujące Cię dane? Ja często używam takiego rozwiązania bo działa szybko i jest prostsze niż korzystanie z wielu zagnieżdżonych funkcji ;P

    Kod poniżej, dołączyłem też plik. Przed użyciem musisz w edytorze VBA dodać referencję do biblioteki "Microsoft AcvtiveX Data Objects 2.8 Library" [ew. wcześniejszej wersji]: Tools -> References, odszukaj ten wpis i zaznacz go ptaszkiem.
    W kluczowych miejscach umieściłem komentarze, żebyś mógł zmodyfikować kod do swoich potrzeb.
    Jedno "ale" - musisz mieć arkusz - bazę, który ma w pierwszym wierszu nazwane kolumny (tutaj: ID klienta i Godzin).

    Code:
    Private Sub CommandButton1_Click()
    
    Dim conn As ADODB.Connection, rst As ADODB.Recordset

    Set wssg = ThisWorkbook.Worksheets("Dane")      'nazwa arkusza z danymi
    Set wswyn = ThisWorkbook.Worksheets("Wyniki")   'nazwa arkusza gdzie mają zostać umieszczone wyniki

    On Error Resume Next
        wssg.ShowAllData
        wswyn.ShowAllData
        wswyn.Range("A2:B65536").ClearContents  'czyści pole przed wstawieniem nowego wyniku
    On Error GoTo 0

    On Error GoTo open_err
        Set conn = New ADODB.Connection
        conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0


    Set rst = New ADODB.Recordset

    Sql = "SELECT [ID klienta], SUM([Godzin]) FROM [Dane$] GROUP BY [ID klienta] ORDER BY [ID klienta]"   'zapytanie SQL - Dane$ to nazwa zakłądaki z danymi, ze znakiem $ na końcu, a ID klienta i Godzin - to (obowiązkowe) tytuły kolumn z których pobierane są dane

    On Error GoTo sql_err
        rst.Open Sql, conn, adOpenStatic
    On Error GoTo 0

    If rst.RecordCount > 0 Then
        wswyn.Cells(2, 1).CopyFromRecordset rst    'tutaj kopiujemy wyniki do zakładki z wynikami, począwszy do drugiego wiersza pierwszej kolumny
    End If

    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing

    MsgBox "Obliczenia zakończone", vbInformation + vbOKOnly, "Koniec"
       
    Exit Sub
    sql_err:
        MsgBox "Błąd SQL: " & Err.Description, vbCritical, "Błąd SQL"
    Exit Sub

    open_err:
        MsgBox Err.Description, vbCritical, "Błąd otwarcia bazy"
    Exit Sub

    End Sub


    Pozdrawiam

    0
  • #3 28 Paź 2009 10:07
    qurek80
    Poziom 9  

    Dzieki bardzo za podpowiedz. A teraz jeszcze jedeno pytanie, jak umiescic ten przycisk w arkuszu excela i zgrac go z kodem?

    0
  • #4 28 Paź 2009 10:45
    marcinj12
    Poziom 40  

    qurek80 napisał:
    Dzieki bardzo za podpowiedz. A teraz jeszcze jedeno pytanie, jak umiescic ten przycisk w arkuszu excela i zgrac go z kodem?

    W Excelu 2003:
    - klikasz prawym przyciskiem w puste miejsce na pasku i klikasz "Visual Basic".
    - z menu które się pokaże klikasz "Przybornik formatów" - ikona młotka i klucza, pokaże się przybornik.
    - wybierasz z niego "Przycisk polecenia" i wstawiasz go gdzieś na arkusz, możesz już zamknąć przybornik.
    - pozycjonujesz przycisk (jeżeli nie możesz go przesuwać - kliknij linijkę i ołówek, wejdziesz w tryb projektowania), nadajesz mu rozmiar etc. Wszystko możesz zrobić klikając go prawym przyciskiem i wybierając z menu kontekstowego "Właściwości". Możesz zmienić tekst na przycisku (CAPTION), czcionkę, kolor etc.
    - klikasz przycisk 2x, otwiera się edytor Visual Basic i automatycznie dodaje coś w stylu:
    Code:
    Private Sub CommandButton1_Click()
    

    End Sub

    - Pomiędzy Private Sub CommandButton1_Click() i End Sub wstawiasz kod który ma się wykonać po kliknięciu przycisku, czyli to co napisałem we wcześniejszym poście (oczywiście pomijasz wtedy Private Sub CommandButton1_Click() i End Sub - ona mają wystąpić tylko raz.
    - pamiętaj o dodaniu referencji do Microsoft ActiveX Data Object 2.8 Library w edytorze.
    - Gdyby coś nie chciało działać, w pliku musisz jeszcze włączyć obsługę makr (z menu Narzędzia -> Makro -> Zabezpieczenia, ustaw na niskie lub średnie)

    A na przyszłość - warto poeksperymentować, nagrywając makro (Narzędzia -> makro -> Zarejestruj nowe makro), robisz coś w Excelu (np. zmieniasz kolor komórki, wstawiasz jakieś dane), kończysz rejestrację i po wciśnięciu ALT+F11 po lewej stronie masz w katalogu Modules np. Module1, jak to klikniesz - masz tam cały kod akcji które wykonałeś. Czasami można go skopiować i wstawić do przycisku jak powyżej bez żadnych modyfikacji, a przynajmniej podpatrzeć sobie kod :)

    0
  • #5 28 Paź 2009 13:07
    qurek80
    Poziom 9  

    Raz jeszcze dzieki za pomoc. Mam jeszcze pytanie, jak w VBL stworzyc program, ktory bedzie otwieral arkusze excela i robil dokladnie to co storzony przycisk?
    Czy mozna tez wzbogacic funkcjonalnosc przycisku o towrzenie wykresu i kolorowanie komorek w zaleznosci od wartosci?

    0
  • Pomocny post
    #6 28 Paź 2009 14:56
    marcinj12
    Poziom 40  

    Pewnie można, ale to już dłuższa historia... :)
    Najprościej - jeżeli plik-źródło jest w tej samej lokacji - wstawić kwerendę wybierającą dane (Dane->Importuj dane zewnętrzne->Nowa kwerenda bazy danych, wybrać Excel Files * i OK, wskazać plik-źródło (można zaznaczyć "Tylko do odczytu"), a dalej z kreatora" wybrać zakładkę, rozwinąć ją krzyżykiem, wybrać pola które mają zostać pobrane, opcjonalnie nałożyć filtr i sortowanie, wybrać arkusz gdzie ma zwrócić dane (warto kliknąć "Właściwości" i odznaczyć 'Dopasuj szerokości kolumn', a zaznaczyć "odśwież dane po otwarciu pliku". Po otwarciu pliku będzie on pytał czy ma pobrać najnowsze dane ze źródła (komunikat "Włącz odświeżanie automatyczne").

    Kolorowanie komórek w zależności od wartości możesz uzyskać stosując formatowanie warunkowe (Format -> Formatowanie warunkowe). Trudne to nie jest, szczegóły w helpie albo na google.

    Wykres możesz wstawić "na stałe" i tylko go odświeżać. Jeżeli dodasz jedną linię w poprzednim kodzie:

    Code:
    ...
    
    If rst.RecordCount > 0 Then
        ile = rst.RecordCount     'zapisz do zmiennej ile ile wierszy zostanie zwróconych
        wswyn.Cells(2, 1).CopyFromRecordset rst     'tutaj kopiujemy wyniki do zakładki z wynikami, począwszy do drugiego wiersza pierwszej kolumny
    End If
    ...

    to możesz odświeżać zakres istniejącego wykresu w taki sposób (wstaw pod koniec, przed komunikatem):

    Code:
    wswyn.ChartObjects(1).Chart.SeriesCollection(1).XValues = wswyn.Range("A2:A" & ile + 1)    'A to kolumna z elementami osi X
    
    wswyn.ChartObjects(1).Chart.SeriesCollection(1).Values = wswyn.Range("B2:B" & ile + 1)    'B to kolumna z w której są wartości odpowiadające kolumnie A

    MsgBox "Obliczenia zakończone", vbInformation + vbOKOnly, "Koniec"


    Podejrzyj plik.

    0
  • #7 28 Paź 2009 15:57
    qurek80
    Poziom 9  

    Raz jeszcze dzieki :) i powalcze troche z ta proba importu danych

    Dodano po 32 [minuty]:

    Utworzylem sobie arkusz excela (nazwijmy go "a") i w nim zrobilem przycisk, ktory otwiera sobie formularz
    "Private Sub CommandButton1_Click()


    Workbooks.Open ("C:\Documents and Settings\xyz\Desktop\team\tr2.xls")
    End Sub
    "
    Teraz mam pytanie drazac ten temat i poprzednie watki. Czy mozna zrobic tak aby pytal sie jaki plik xls ma otowrzyc? Druga sprawa czy mozna tak skonfigurwac wczesniejszy programik o sumowaniu komorek w ten sposob by z poziomu arkusza "a" dokonywal obliczen w arkuszu otwartym i zwracal dane do arkusza "a"?

    0
  • #8 29 Paź 2009 09:04
    marcinj12
    Poziom 40  

    Ja pisząc makra w VBA zawsze sobie deklaruję odwołanie do poszczególnych arkuszy, dzięki czemu łatwo można się później po nich poruszać.
    Robi się to w ten sposób:

    Code:
    Set wssg = ThisWorkbook.Worksheets("Strona główna")

    gdzie ThisWorkbook oznacza - jakże by inaczej ;), bieżący dokument Excela.

    Jeżeli otworzysz plik w ten sposób:
    Code:
    Set wb = Workbooks.Open ("C:\Documents and Settings\xyz\Desktop\team\tr2.xls") 
    
    Set wswynik = wb.Worksheets("Wynik")


    to pod wswynik będziesz miał odwołanie do zakładki o nazwie "Wynik" w otwartym pliku, więc pisząc
    Code:
    wssg.cells(1, 1) = "Cześć"

    i podpinając to do przycisku w innym arkuszu, będziesz pisał do arkusza w drugim pliku. Po wszystkim możesz otwarty plik zamknąć zapisując lub nie zmiany:
    Code:

    wb.Close savechanges:=True   'zamyka z zapisem zmian



    Akurat mam pod ręką kod do otwierania okienka dialogowego: musisz tylko dodać referencję do Microsoft Office 12 Library (lub wcześniejszej wersji). Jeżeli pokombinujesz z ustawieniem odpowiednich nazw arkuszy, to możesz czytać dane z otwartego pliku (Set wsdane = wb.Worksheets("Dane")) a zwracać do bieżącego (Set wswynik = ThisWorkbook.Worksheets("Wynik")).

    Code:

    Private Sub CommandButton12_Click()
    Dim sciezka As String

    With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .Filters.Clear
            .Filters.Add "Pliki Excel", "*.xls"
            .Filters.Add "Wszystkie pliki", "*.*"
            .FilterIndex = 1
            .InitialFileName = "C:\"
            .Show
     
            For lngCount = 1 To .SelectedItems.Count
                sciezka = .SelectedItems(lngCount)
            Next lngCount
    End With

    If sciezka <> "" Then
       Set wb = Workbooks.Open(sciezka)
       '.......dalsza część kodu
    End If

    End Sub

    0
  • #9 29 Paź 2009 10:07
    qurek80
    Poziom 9  

    Dzieki bardzo za pomoc raz jeszcze. Probowalem pokomilowac co niec i zrobilem sobie arkusz z dwoma przyciskami.
    Kod wyglada nastepujaco
    "
    Private Sub CommandButton1_Click()
    Dim sciezka As String

    With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Pliki Excel", "*.xls"
    .Filters.Add "Wszystkie pliki", "*.*"
    .FilterIndex = 1
    .InitialFileName = "C:\"
    .Show

    For lngCount = 1 To .SelectedItems.Count
    sciezka = .SelectedItems(lngCount)
    Next lngCount
    End With

    If sciezka <> "" Then
    Set wb = Workbooks.Open(sciezka) '.......dalsza cze;s'c' kodu
    End If

    End Sub


    Private Sub CommandButton2_Click()
    Dim conn As ADODB.Connection, rst As ADODB.Recordset

    Set wssg = wb.Worksheets("Sheet1") 'nazwa arkusza z danymi
    Set wswyn = ThisWorkbook.Worksheets("Wyniki") 'nazwa arkusza gdzie maja; zostac' umieszczone wyniki

    On Error Resume Next
    wssg.ShowAllData
    wswyn.ShowAllData
    wswyn.Range("A2:B65536").ClearContents 'czyssci pole przed wstawieniem nowego wyniku
    On Error GoTo 0

    On Error GoTo open_err
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0


    Set rst = New ADODB.Recordset

    Sql = "SELECT [Activity], SUM([hours]) FROM [Dane$] GROUP BY [Activity] ORDER BY [Activity]" 'zapytanie SQL - Dane$ to nazwa zak?a;daki z danymi, ze znakiem $ na kon'cu, a ID klienta i Godzin - to (obowia;zkowe) tytu?y kolumn z których pobierane sa; dane

    On Error GoTo sql_err
    rst.Open Sql, conn, adOpenStatic
    On Error GoTo 0

    If rst.RecordCount > 0 Then
    wswyn.Cells(2, 1).CopyFromRecordset rst 'tutaj kopiujemy wyniki do zak?adki z wynikami, pocza;wszy do drugiego wiersza pierwszej kolumny
    End If

    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing

    MsgBox "Job done", vbInformation + vbOKOnly, "Koniec"

    Exit Sub
    sql_err:
    MsgBox "Blad SQL: " & Err.Description, vbCritical, "Blad SQL"
    Exit Sub

    open_err:
    MsgBox Err.Description, vbCritical, "Blad otwarcia bazy"

    End Sub

    "
    Na koniec dostaje Error 424 i nie bardzo wiem o co mu chodzi.

    Probowalem w arkuszu nr 1. zrobic tak aby przy po mocy Set wssg = wb.Worksheets("Sheet1") czytal dane z otwartego (za pomoca pierwszej czesci kodu) arkusza czytal dane, ale chyba cos mi nie wyszlo.
    Jak to poprawic?

    0
  • Pomocny post
    #10 29 Paź 2009 10:29
    marcinj12
    Poziom 40  

    Dzieje się tak, ponieważ każda zmienna jest domyślnie widoczna tylko w obrębie danej procedury.
    Nie możesz w CommandButton1_Click() przypisać Set wb = Workbooks.Open(sciezka), a próbować ją odczytać w innej: CommandButton2_Click().

    Żeby nie kombinować ze zmiennymi globalnymi:
    1. Albo w CommandButton1_Click() w miejscu komentarza '.......dalsza część kodu wstaw CAŁY kod z CommandButton2_Click: wtedy nie będziesz potrzebował drugiego przycisku, cała akcja wykona się po wybraniu pliku,

    2. Albo do procedury Private Sub CommandButton2_Click() przekazujesz np. ścieżkę pliku do otwarcia, przenosisz do niej otwarcie pliku. Nie ma sensu podpinać jej do przycisku, więc zmieniłem też jej nazwę:

    Code:

    Private Sub WykonajObliczenia(sciezka as string)
    Dim conn As ADODB.Connection, rst As ADODB.Recordset

    If sciezka <> "" Then
        Set wb = Workbooks.Open(sciezka)
    End If

    Set wssg = wb.Worksheets("Sheet1") 'nazwa arkusza z danymi
    Set wswyn = ThisWorkbook.Worksheets("Wyniki") 'nazwa arkusza gdzie maja; zostac' umieszczone wyniki

    On Error Resume Next
    wssg.ShowAllData
    wswyn.ShowAllData
    wswyn.Range("A2:B65536").ClearContents 'czyssci pole przed wstawieniem nowego wyniku
    On Error GoTo 0

    On Error GoTo open_err
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0


    Set rst = New ADODB.Recordset

    Sql = "SELECT [Activity], SUM([hours]) FROM [Dane$] GROUP BY [Activity] ORDER BY [Activity]" 'zapytanie SQL - Dane$ to nazwa zak?a;daki z danymi, ze znakiem $ na kon'cu, a ID klienta i Godzin - to (obowia;zkowe) tytu?y kolumn z których pobierane sa; dane

    On Error GoTo sql_err
    rst.Open Sql, conn, adOpenStatic
    On Error GoTo 0

    If rst.RecordCount > 0 Then
    wswyn.Cells(2, 1).CopyFromRecordset rst 'tutaj kopiujemy wyniki do zak?adki z wynikami, pocza;wszy do drugiego wiersza pierwszej kolumny
    End If

    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing

    MsgBox "Job done", vbInformation + vbOKOnly, "Koniec"

    Exit Sub
    sql_err:
    MsgBox "Blad SQL: " & Err.Description, vbCritical, "Blad SQL"
    Exit Sub

    open_err:
    MsgBox Err.Description, vbCritical, "Blad otwarcia bazy"

    End Sub


    a wywołujesz ją tak: w CommandButton1_Click() w miejscu komentarza:
    '.......dalsza część kodu wywołujesz procedurę poleceniem:
    Code:
    Call WykonajObliczenia(sciezka)

    0
  • #11 29 Paź 2009 11:40
    qurek80
    Poziom 9  

    To teraz caly kod wyglada tak
    "Private Sub CommandButton1_Click()
    Dim sciezka As String

    With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Pliki Excel", "*.xls"
    .Filters.Add "Wszystkie pliki", "*.*"
    .FilterIndex = 1
    .InitialFileName = "C:\"
    .Show

    For lngCount = 1 To .SelectedItems.Count
    sciezka = .SelectedItems(lngCount)
    Next lngCount
    End With

    If sciezka <> "" Then
    Set wb = Workbooks.Open(sciezka)
    Call WykonajObliczenia(sciezka) ' odwolanie do nastepnej funkcji
    End If

    End Sub

    Private Sub WykonajObliczenia(sciezka As String)
    Dim conn As ADODB.Connection, rst As ADODB.Recordset

    If sciezka <> "" Then
    Set wb = Workbooks.Open(sciezka)
    End If

    Set wssg = wb.Worksheets("Sheet1") 'nazwa arkusza z danymi
    Set wswyn = ThisWorkbook.Worksheets("Wyniki") 'nazwa arkusza gdzie maja; zostac' umieszczone wyniki

    On Error Resume Next
    wssg.ShowAllData
    wswyn.ShowAllData
    wswyn.Range("A2:B65536").ClearContents 'czyssci pole przed wstawieniem nowego wyniku
    On Error GoTo 0

    On Error GoTo open_err
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0


    Set rst = New ADODB.Recordset

    Sql = "SELECT [Activity], SUM([hours]) FROM [Sheet1$] GROUP BY [Activity] ORDER BY [Activity]" 'zapytanie SQL - Dane$ to nazwa zak?a;daki z danymi, ze znakiem $ na kon'cu, a ID klienta i Godzin - to (obowia;zkowe) tytu?y kolumn z których pobierane sa; dane

    On Error GoTo sql_err
    rst.Open Sql, conn, adOpenStatic
    On Error GoTo 0

    If rst.RecordCount > 0 Then
    wswyn.Cells(2, 1).CopyFromRecordset rst 'tutaj kopiujemy wyniki do zak?adki z wynikami, pocza;wszy do drugiego wiersza pierwszej kolumny
    End If

    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing

    MsgBox "Job done", vbInformation + vbOKOnly, "Koniec"

    Exit Sub
    sql_err:
    MsgBox "Blad SQL: " & Err.Description, vbCritical, "Blad SQL"
    Exit Sub

    open_err:
    MsgBox Err.Description, vbCritical, "Blad otwarcia bazy"

    End Sub"

    Otwiera plik, proboje wykonac obliczenia ale dostaje blad SQL: No value given for one or more required parameters. No i stoi i nie wiem co dalej.

    0
  • #12 29 Paź 2009 12:34
    marcinj12
    Poziom 40  

    Jak wstawiasz kod używaj znaczników [ Code ] :)

    Trochę Cię nie zrozumiałem, jeżeli chcesz tylko POBIERAĆ dane z pliku-źródła, nie musisz go nawet otwierać... usuń wszystkie fragmenty kodu odpowiedzialne za otwarcie pliku, a w miejscu gdzie łączysz się z plikiem:

    Code:

    On Error GoTo open_err
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0

    zamień ThisWorkbook.FullName na sciezka, gdzie sciezka jest przekazanym do procedury parametrem z pełną ścieżką dostępu do pliku z którego pobierasz dane. W ten sposób połączysz się z wybranym plikiem - tylko upewnij się że nazwy arkuszy i pól się zgadzają...

    0
  • #13 29 Paź 2009 14:20
    qurek80
    Poziom 9  

    Super :) Dziala rewelacja, szczerze to wykorzystalem
    <code>
    On Error GoTo open_err
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0;"
    On Error GoTo 0
    </code>

    I dziala.

    Dodano po 59 [minuty]:

    Dzieki bardzo za pomoc. Mam jeszcze jedno pytanko- probowalem samemu dopisujac jeszcze jedna linijke do miejsca gdzie jest sumowanie godzin do projektow. Probowalem dodac linijke aby tez sumowal pracownikow, ktorzy zajmowali sie danymi projektami i SQL wyrzucil blad.
    Ogolnie plik, na ktorym dokonywane sa akcje sklada sie z kilku kolumn- jest ID klienta, sa godziny i sa pracownicy ktorzy pracowali dla danego klienta (kolumna ma etykietke SIGN).
    Czy do wynikow mozna dodac jeszcze pare kolumn w ktorych widac by bylo ile dany pracownik spedzil nad danym klientem?

    Probowalem tez stworzyc nowy ADODB recordset ale to tez nic nie dalo

    0
  • Pomocny post
    #14 29 Paź 2009 15:06
    marcinj12
    Poziom 40  

    Za wybieranie rekordów odpowiada zapytanie SQL, w tym kodzie to fragment:

    Code:
    Sql = "SELECT [ID klienta], SUM([Godzin]) FROM [Dane$] GROUP BY [ID klienta] ORDER BY [ID klienta]"

    Jeżeli chcesz dodać kolumnę o nazwie SIGN i grupować najpierw po ID klienta, a później po niej, napisz:
    Code:
    Sql = "SELECT [ID klienta], [SIGN], SUM([Godzin]) FROM [Dane$] GROUP BY [ID klienta], [SIGN] ORDER BY [ID klienta], [SIGN]"

    W GROUP BY podajesz w jakiej kolejności ma grupować (dla sumy musisz podać wszystkie kolumny których nie sumujesz), w ORDER BY - w jakiej kolejności chcesz sortować wynik. Poczytaj na google dla hasła: SQL SELECT.
    PS. Nazwy kolumn muszą być w pierwszym wierszu i nie możesz mieszać typów, np. w kolumnie z godzinami (liczba) wpisać (tekst) N/D albo "brak"!

    0
  • #15 29 Paź 2009 15:48
    qurek80
    Poziom 9  

    Dzieki za info. Juz wczesniej udalo mi sie wykombinowac to sortowanie. Tak jak piszesz to sortuje w ten sposob ze wypisuje
    ID klienta Hours total| employee hours| employee hours
    D21111 10 aaaa 5 bbbb 3 dddd 2

    probowalem to zrobic tak
    <code>
    Sql = "SELECT [Activity],[SIGN], SUM([hours]) FROM [Sheet1$] GROUP BY [Activity], [SIGN] ORDER BY [Activity], [SIGN]"
    </code>

    tylko ze wyrzuca to tak
    D21111 aaaa 2
    D21111 bbbb 3
    D21111 cccc 4

    0
  • #16 29 Paź 2009 16:09
    marcinj12
    Poziom 40  

    qurek80 napisał:
    Dzieki za info. Juz wczesniej udalo mi sie wykombinowac to sortowanie. Tak jak piszesz to sortuje w ten sposob ze wypisuje
    ID klienta Hours total| employee hours| employee hours
    D21111 10 aaaa 5 bbbb 3 dddd 2

    probowalem to zrobic tak
    <code>
    Sql = "SELECT [Activity],[SIGN], SUM([hours]) FROM [Sheet1$] GROUP BY [Activity], [SIGN] ORDER BY [Activity], [SIGN]"
    </code>

    tylko ze wyrzuca to tak
    D21111 aaaa 2
    D21111 bbbb 3
    D21111 cccc 4

    Nie rozumiem o co chodzi :)
    To co dostałeś jest OK - najpierw masz pogrupowane po activity (D21111), potem po użytkowniku (SIGN), i dla każdego użytkownika przypisanego do danej Activity masz sumę z ilości godzin. W czym więc problem?

    0
  • #17 29 Paź 2009 16:15
    qurek80
    Poziom 9  

    Zeby activity wyrzucal raz a obok w kolejnych rzedach wypisywal urzytkownikow, ktorzy pracowali nad tym klientem przez ilosc godzin i tu kobinowalem roznie i na ogol dostaje error

    Dodano po 1 [minuty]:

    czyli aby bylo 21111 10 aaa 5 bbb 3 ccc 2. Nie wiem czy takie cos jest mozliwe

    0
  • Pomocny post
    #18 29 Paź 2009 21:48
    marcinj12
    Poziom 40  

    qurek80 napisał:

    czyli aby bylo 21111 10 aaa 5 bbb 3 ccc 2. Nie wiem czy takie cos jest mozliwe

    Hmmm, teraz już będzie trudniej ;)
    Na szczęście Excel i VBA oferują coś a'la tabelki przestawne. Zmień zapytanie SQL na
    Code:
    Sql = "TRANSFORM [SIGN] & "" "" & Sum([hours]) " & _
    
    "SELECT [Activity], Sum([hours]) " & _
    "FROM [Sheet1$] " & _
    "GROUP BY [Activity] " & _
    "PIVOT [SIGN]"

    to Ci zarobi coś takiego - jak widzisz, jeżeli osoba aaa nie wystąpi w drugim projekcie, pole będzie puste, tak samo jak osoby ccc i ddd dla projektu 1:
    Code:

    D21111   |   3   |   aaa 2   |   bbb 1   |       
    D21112   |   6   |           |   bbb 2   |   ccc 2   |   ddd 2

    A jeżeli ma nie być tych luk - zmień
    Code:
    wswyn.Cells(2, 1).CopyFromRecordset rst

    na
    Code:

    i = 2
    While Not rst.EOF   'dla każdego wiersza wyniku
        wswyn.Cells(i, 1) = rst.Fields(0)   'wypisz activity   
        wswyn.Cells(i, 2) = rst.Fields(1)   'wypisz total hours
        kol = 3   'kolumna od której zaczynamy wstawianie
        For j = 2 To rst.Fields.Count - 1    'dla wybranego wiersza z recordset'a, począwszy od kolumny 3
            If rst.Fields(j) <> " " Then   'jeżeli wartość w tej kolumnie nie jest równa " " - to jeśli w SQLu używamy złączania w TRANSFORM... "" ""
                wswyn.Cells(i, kol) = rst.Fields(j)    'wypisz niepustą wartość
                kol = kol + 1    '...i przejdź na następną kolumnę
            End If
        Next j
        i = i + 1
        rst.MoveNext   'kolejny wiersz z recordset'a
    Wend

    0
  • #19 30 Paź 2009 09:05
    qurek80
    Poziom 9  

    Super, uzlem tego drugiego sposobu (bez luk), a jak go sformatowac coby liczby (hours) wystawial w odzielnej komorce obok sign? i to chyba juz ostatnie moje pytanie :)

    0
  • #20 30 Paź 2009 10:26
    marcinj12
    Poziom 40  

    Oj, chłopie :D Kilka postów wcześniej sam rozdzieliłeś pionową kreską przykład tak, jakby te wartości miały być w jednej komórce...

    Akurat nie wiem jak by to można zrobić w jednym zapytaniu, więc rozbiłem je na dwa ;)

    1. Zmień zapytanie SQL na:

    Code:
    Sql = "SELECT [Activity], SUM([hours]) FROM [Dane$] as A GROUP BY [Activity] ORDER BY [Activity]"

    to Ci wybierze tylko niepowtarzające się wartości [Activity] i dla każdej z nich "total hours"

    2. Teraz, dla każdego wiersza z [Activity] można w podobny sposób wybrać użytkowników i godziny przypisanych do danej [Activity], a następnie wiersze z tego wyniku przekształcić w kolumny. Zmień fragment:
    Code:

    If rst.RecordCount > 0 Then
        ile = rst.RecordCount
             
        Set rst2 = New ADODB.Recordset      'drugi recordset
       
        wiersz = 2  'wiersz od którego zaczynamy wstawianie wyników
        While (Not rst.EOF) And (wiersz < 65536)   
            'wstaw [Activity] i jej "total hours"
            wswyn.Cells(wiersz, 1) = rst.Fields(0)
            wswyn.Cells(wiersz, 2) = rst.Fields(1)
           
            '----- drugie podzapytanie bazujące na wynikch z pierwszego
            Sql2 = "SELECT [SIGN], Sum([hours]) FROM [Dane$] WHERE [Activity] = '" & rst.Fields(0) & "' GROUP BY [SIGN]"
            On Error GoTo sql_err
                rst2.Open Sql2, conn, adOpenStatic
            On Error GoTo 0
           
            kol = 3     'kolumna od której zaczynamy wypisywanie [SIGN1] [hours1] [SIGN2] [hours2] ...
            While (Not rst2.EOF) And (kol < 255)
                wswyn.Cells(wiersz, kol) = rst2.Fields(0)
                wswyn.Cells(wiersz, kol + 1) = rst2.Fields(1)
                kol = kol + 2
                rst2.MoveNext
            Wend
            rst2.Close
            '---------
           
            wiersz = wiersz + 1
            rst.MoveNext
        Wend
       
        Set rst2 = Nothing
    End If

    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing


    W razie wątpliwości - podejrzyj plik.
    Pozdrawiam i powodzenia :)

    0
  • #21 30 Paź 2009 10:57
    qurek80
    Poziom 9  

    Dzieki bardzo za cala pomoc :-). Moj szef jest very happy.

    0
  • #22 02 Lis 2009 10:19
    qurek80
    Poziom 9  

    A jednak jeszcze jedno pytanie. Czy mozna na funckji select wymusic tak aby wyswietlala wyniki od najwiekszego do najmniejszego?
    Tzn teraz wyswietla tak
    D1111 | 9| aaa |3| bbb |2| ccc |4| a czy moglby wyswietlac
    D1111 |9| ccc |4| aaa |3| bbb |2|

    0
  • #23 02 Lis 2009 16:24
    marcinj12
    Poziom 40  

    Tak, można :)
    Służy do tego klauzula ORDER BY [nazwa_pola] ASC | DESC (asc=rosnąco, desc=malejąco):
    czyli jeśli drugie zapytanie zapiszesz tak:

    Code:

    Sql2 = "SELECT [SIGN], Sum([hours]) FROM [Dane$] WHERE [Activity] = '" & rst.Fields(0) & "' GROUP BY [SIGN] ORDER BY Sum([hours]) DESC, [SIGN] ASC"

    ta najpierw będzie sortowało wynik po sumie(godzin) malejąco, a następnie po [SIGN] rosnąco.

    0