VBA - Sumowanie danych w tabeli mających tą samą nazwę

Question

Witam,

od pewnego czasu pracuję nad zestawieniem w programie Excel, w którym zawarte mam dane kontrahentów (nazwę kontrahenta, wartość sprzedaży). Chciałabym przy wykorzystaniu języka Visual Basic móc zsumować wszystkie dane dla kontrahenta, np. "Kowalski" i aby wynik w/w sumowania ukazał się w komórce obok. Próbowałam wykorzystać do tego funkcję SumIf, z tym że uruchomiony program nie robi kompletnie nic. Bardzo proszę o informację co robię źle, że program nie chce zadziałać. Z góry bardzo dziękuję za pomoc.

         A                  B

KOWALSKI	2264
KOWALSKI	344
KOWALSKI	4585
KOWALSKI	1232
NOWAK	23455
STRZELCZYK	4844

Sub zsumujDane()

Dim wynikSumy As Long

wynikSumy = Range("E1").Value

wynikSumy = Application.WorksheetFunction.SumIf(Range("A1:A6"), "KOWALSKI", Range("B1:B6"))

End Sub

 

Answer 1

Najpierw oblicz sumę za pomocą funkcji SumIf, czyli

Sub zsumujDane() 
    Dim wynikSumy As Long

    wynikSumy = Application.WorksheetFunction.SumIf(Range("A1:A6"), "KOWALSKI", Range("B1:B6"))
    wynikSumy = Range("E1").Value 
End Sub

teraz przypisz wartość obliczoną, którą "przechowuje" zmienna wynikSumy do komórki E1, czyli

Sub zsumujDane() 
    Dim wynikSumy As Long

    wynikSumy = Application.WorksheetFunction.SumIf(Range("A1:A6"), "KOWALSKI", Range("B1:B6"))
    Range("E1").Value = wynikSumy
End Sub

 

 

 

P.S. "Podkręciłem" trochę Twój kod VBA,

• teraz możesz dopisywać więcej linii (wierszy) bez potrzeby zmiany kodu
• podwójne kliknięcie lewym przyciskiem myszki w nazwisko wywołuje SumIf z nazwiskiem, które znajduje się w komórce
   
  

 

zapisz ten kod w (edytora VBA - Alt + F11 )
 

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not IsEmpty(Target.Value) And Target.Column = 1 Then
        zsumujDane (Target.Value)
        Cancel = True
    End If
End Sub

Sub zsumujDane(ByVal name As String)
    Dim wynikSumy As Long
    Dim wynik, ostatni_wiersz As String
 
    ostatni_wiersz = CStr(Cells(Rows.Count, 1).End(xlUp).Row)
 
    wynikSumy = WorksheetFunction.SumIf(Range("A1:A" + ostatni_wiersz), name, Range("B1:B" + ostatni_wiersz))
    wynik = " " + name + ": " + CStr(wynikSumy)
    
    Range("E1").Value = wynik
    Range("E1").ColumnWidth = Len(wynik) + 2
End Sub

 

Comments

Bardzo dziękuję za pomoc :)

Przez ten czas udało mi się trochę rozwinąć mój kod, z tym że napotkałam nowy problem, a mianowicie w pliku Excel mam dwa arkusze: z zestawieniem, z bazą. Zrobiłam pętlę for, która przeszukuje mi oba arkusze w poszukiwaniu danych o takiej samej nazwie i następnie sumuje ich wartości za pomocą funkcji sumif. Aktualnie próbuję wprowadzić instrukcję warunkową, z tym że najwidoczniej coś robię źle, ponieważ wyskakuje mi okienko z błędem "Run-time error '13': Type mismatch" i kod niestety nie wykonuje się, a ja stoję przez to w miejscu, ponieważ nie jestem w stanie tego rozwiązać. Będę bardzo wdzięczna za pomoc i z góry ogromnie za nią dziękuję:)

Dim sheetBaza As Worksheet
Dim lastRow As Long
Dim i As Long

Set sheetBaza = Worksheets("BAZA")
lastRow = Cells(Rows.Count, "D").End(xlUp).Row

For i = 3 To lastRow
If sheetBaza.Range("L:L") = "WEDLINA" Then
Cells(i, 6) = WorksheetFunction.SumIf(sheetBaza.Range("D:D"), Cells(i, 4), sheetBaza.Range("O:O"))
Else: Cells(i, 6) = ""
End If
Next i

 

---

Tutaj powinien być typ String

Cells(i, 6) = ...

ponieważ ten zapis jest domyślny i mógłby wyglądać tak

Cells(i, 6).Value = ...

a SumIf zwraca Long-a

myślę, że taki zapis powinien "załatwić" sprawę  ( CStr() )

Cells(i, 6) = CStr(WorksheetFunction.SumIf(sheetBaza.Range("D:D"), Cells(i, 4), sheetBaza.Range("O:O")))

 

---

Wprowadziłam zaproponowaną przez Pana zmianę, jednak w dalszym ciągu w momencie pojawienia się błędu "Run-time error '13': Type mismatch" podświetla mi na żółto wiersz z użytą przeze mnie instrukcją warunkową :( Jeszcze raz spróbuję wyjaśnić co chciałabym uzyskać w zestawieniu.

W pliku posiadam dwa arkusze: I - ogólne zestawienie, II - baza danych. W zestawieniu arkusza I w kolumnie "D" widnieją nazwy kontrahentów. Pętla przeszukuje mi arkusz II (baza) i znajduje wszystkich kontrahentów o takiej samej nazwie, jak w arkuszu I. Po odszukaniu ich używam instrukcji warunkowej, która mówi, że jeśli w kolumnie "L" arkusza II są wiersze z nazwą "WEDLINA" to należy wziąć wszystkie wiersze z w/w nazwą, zsumować ich wartość netto znajdującą się w kolumnie "O" (arkusz II) za pomocą funkcji SumIf i wprowadzić uzyskane wyniki sumowania pod odpowiednich kontrahentów w arkuszu I.

Z góry bardzo dziękuję za pomoc i przepraszam, że tyle czasu nie mogę uporać się z tym problemem ;)

Answer 2

Program oblicza wynikSumy, tylko nie przypisujesz tego wyniku do komórki E1, a zamiast tego, wcześniej, przypisujesz wartość tej komórki.