napisał: Gubernator
postów: 17
 umieszczony:
22 września 2005
07:46
|
|
Cześć,
Bardzo dziękuję Ci za pomoc. Nie znam Twojego e-mail, ale zróbmy tak: podam Ci swój i prześlij mi nawet pustego maila, odeślę Ci mój plik.
Mój e-mail: cybermania@wp.pl
Dzięki
Jarek |
|
|
napisał: Stanislaw
postów: 109
umieszczony:
21 września 2005
16:22
|
|
Cześć,
W takim razie - czy mógłbyś podesłać na mój adres
skoroszyt na którym testowałeś działanie kodu?
Chciałbym doprowadzić sprawę do szczęśliwego końca.
Dane mogą być prawdziwe lub fikcyjne - chodzi mi o ich strukturę.
--
Stanislaw |
|
|
napisał: Gubernator
postów: 17
umieszczony:
21 września 2005
08:56
|
|
Cześć,
zmieniłem w kodzie nazwy arkuszy na takie jak moje, niestety przy wierszu gdzie jest
wartość = wartość + składnik
przy składniku wyświetla mi błąd Err 2007
chyba jestem zbyt wielkim laikiem aby sobie z tym poradzić  |
|
|
napisał: Stanislaw
postów: 109
umieszczony:
20 września 2005
22:53
|
|
Witaj,
Czasem trudno na pierwszy rzut oka rozszyfrować cudzy kod.
A ja z kolei zupełnie nie opisałem zmiennych.
Zauważ jednak instrukcję:
składnik = Cells(wiersz, kolumna + 1).Value
która sprawia, że do zmiennej "składnik" jest początkowo przypisywana wartość z pierwszego wiersza
i cały czas z drugiej kolumny.
Następnie do zmiennej "składnik" są przypisywane wartości z kolejnych wierszy.
> składnik może przyjąć wartość tylko "d" lub "p", a to oznacza, że nie można by tego dodać.
A czy próbowałeś uruchamiać procedurę?
Testowałem procedurę na fikcyjnych danych o strukturze podanej przez Ciebie i wydawało mi się, że działa poprawnie.
Ale oczywiście wypróbuj działanie na kopii swoich oryginalnych danych, aby wyłapać ewentualne niedoskonałości.
Podaną procedurę należy oczywiście odpowiednio dostosować zmieniając nazwy arkuszy, itd.
Nie jest ona oczywiście uniwersalna, bo aby tak było należałoby znacznie rozbudować kod,
należy np. pamiętać aby uruchamiać ją tylko wtedy, gdy aktywny jest właściwy arkusz,
a dane w nim posortowane wg pierwszej i trzeciej kolumny.
Spróbuj przeanalizować kod procedur, wtedy łatwiej będzie Ci je dostosowywać do swoich potrzeb.
W razie niejasności daj znać - być może dałoby się coś jeszcze udoskonalić 
--
Pozdrawiam
Stanislaw |
|
|
napisał: Gubernator
postów: 17
umieszczony:
20 września 2005
21:50
|
|
Bardzo dziękuję Ci za tak rozbudowany kod. To jest sztuka!!!!
Lecz czy mógłbym coś jeszcze dopowiedzieć.Opiszę jak wygląda mój arkusz.
Arkusz pierwszy nazwałem "Rozliczenie" znajduje się tam w sumie 40 tabelek, które rozbijają mi koszt na poszczególne pozycje. Tak podzielony koszt, przenoszony jest do innego arkusza o nazwie "Arkusz3". Tam już jest to można powiedzieć "słupek" składa się już tylko z 3 kolumn i w sumie 603 wierszy. Kolumna pierwsz to załóżmy "nr klienta", druga to wyliczony koszt, a trzecia to określenie dodatkowe w postaci "d" lub "p". 3 arkusz nazwya się "Drukuj" i tam usuwało mi i dodawało odpowiednie wiersze. Jeżeli Twoja koncepcja jest inna to nie ma problemu, wszystko można zmienić. Mam tylko uwagę, bo z tego jak zrozumiałem kod to np. gdzie masz
wartość = wartość + składnik
składnik może przyjąć wartość tylko "d" lub "p", a to oznacza, że nie można by tego dodać.
Dziękuję Ci bardzo za to co do tej pory zrobiłeś... naprawdę jestem pod wrażeniem, też kiedyś chciałbym się nauczyć tak programować.
Pozdrawiam
Jarek |
|
|
napisał: Stanislaw
postów: 109
umieszczony:
20 września 2005
13:33
|
|
Kolejna wersja:
Sub sumowanie()
Dim wiersz As Long
Dim kolumna As Long
Dim wartość
Dim składnik
Dim nr_nazwa As Long
wiersz = 1
kolumna = 1
wartość = 0
składnik = 0
nr_nazwa = 0
Call Usuń_puste_wiersze
Do Until Cells(wiersz, kolumna).Value = ""
składnik = Cells(wiersz, kolumna + 1).Value
If Cells(wiersz + 1, kolumna).Value = Cells(wiersz, kolumna).Value And _
Cells(wiersz + 1, kolumna + 2).Value = Cells(wiersz, kolumna + 2).Value Then
wartość = wartość + składnik
Else
With Worksheets("Arkusz2")
.Cells(1 + nr_nazwa, 1).Value = Cells(wiersz, kolumna).Value
.Cells(1 + nr_nazwa, 2).Value = Cells(wiersz, kolumna + 2).Value
.Cells(1 + nr_nazwa, 3).Value = wartość + składnik
End With
wartość = 0
nr_nazwa = nr_nazwa + 1
End If
wiersz = wiersz + 1
Loop
End Sub
Sub Usuń_puste_wiersze()
Dim i As Long
Application.ScreenUpdating = False
For i = Worksheets("Arkusz1").UsedRange.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("Arkusz1").UsedRange.Rows(i).EntireRow) = 0 Then _
Worksheets("Arkusz1").UsedRange.Rows(i).EntireRow.Delete
Next i
Application.ScreenUpdating = False
End Sub
--
Stanislaw |
|
|
napisał: Stanislaw
postów: 109
umieszczony:
19 września 2005
22:42
|
|
Na razie wykonałem pierwszy krok na drodze do celu,
zmieniłem też trochę koncepcję rozwiązania.
Przyjąłem, że dane wyjściowe znajdują się w arkuszu "Arkusz1",
natomiast sumowania są umieszczane w arkuszu "Arkusz2".
Dane w arkuszu "Arkusz1" są modyfikowane tylko o tyle,
że są w nim usuwane zupełnie puste wiersze,
natomiast pozostawiane wiersze z wartością zerową.
Dane w tym arkuszu powinny być oczywiście posortowane
wg pierwszej kolumny.
Na obecnym etapie biorę pod uwagę tylko wpisy w dwóch kolumnach,
tj. nie uwzględniam "oznaczeń dodatkowych".
W kolejnym etapie będę chciał ująć "oznaczenia dodatkowe"
z kolumny trzeciej.
Sub sumowanie()
Dim wiersz As Long
Dim kolumna As Long
Dim wartość
Dim składnik
Dim nr_nazwa As Long
wiersz = 1
kolumna = 1
wartość = 0
składnik = 0
nr_nazwa = 0
Call Usuń_puste_wiersze
Do Until Cells(wiersz, kolumna).Value = ""
składnik = Cells(wiersz, kolumna + 1).Value
If Cells(wiersz + 1, kolumna).Value = Cells(wiersz, kolumna).Value Then
wartość = wartość + składnik
Else
With Worksheets("Arkusz2")
.Cells(1 + nr_nazwa, 1).Value = Cells(wiersz, kolumna).Value
.Cells(1 + nr_nazwa, 2).Value = wartość + składnik
End With
wartość = 0
nr_nazwa = nr_nazwa + 1
End If
wiersz = wiersz + 1
Loop
End Sub
Sub Usuń_puste_wiersze()
Dim i As Long
Application.ScreenUpdating = False
For i = Worksheets("Arkusz1").UsedRange.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("Arkusz1").UsedRange.Rows(i).EntireRow) = 0 Then _
Worksheets("Arkusz1").UsedRange.Rows(i).EntireRow.Delete
Next i
Application.ScreenUpdating = False
End Sub
Będę wdzięczny za przetestowanie i przesłanie sugestii i uwag.
--
Pozdrawiam
Stanislaw |
|
|
napisał: Gubernator
postów: 17
umieszczony:
19 września 2005
17:23
|
|
| Dokładnie, usuwa wiersze puste i z wartością zero. Potem chodzi mi o to żeby np. jeżeli w nazwie mam AAA i to (AAA) wytępuję w tabeli powiedzmy 5 razy i przy każdym AAA jest inna wartość, chciałbym żeby była tylko jedna pozycja z AAA a w kolumnie obok zsumowane wszystkie wartości AAA jakie pojawiły się w tabeli. |
|
|
napisał: Stanislaw
postów: 109
umieszczony:
18 września 2005
23:13
|
|
Czyli najpierw usunąć wiersze puste
oraz te, które w kolumnie "wartość" mają wpisaane zero?
A poza tym gdzie te podsumowania miałyby się pojawiać?
Rozumiem, że dla każdej nazwy byłyby dwa podsumowania:
określona nazwa z oznaczeniem dodatkowym "d"
oraz
określona nazwa z oznaczeniem dodatkowym "p"
--
Stanislaw |
|
|
napisał: Gubernator
postów: 17
umieszczony:
18 września 2005
13:14
|
|
Mam w arkuszu 3 kolumny,
1 - nazwa
2 - wartość
3 - oznaczenie dodtakowe, które przyjmuje wartości tylko "d" lub "p"
wierszy jest w sumie 603, teoretycznie w każdym może wystąpić inna wartość, ale często się powtarzają. Chciałbym aby wartości o tym samych nazwach sumowały się ale tylko jeżeli oznaczenie dodatkowe jest takie samo. Rozpocząłem pracę ale niestety nie mogę przeskoczyć tego żeby się sumowało bez warunku, a wiersze puste lub o wartośći zero poprostu się kasowały, pomożecie?[vbcode]
[/vbcode]Public Sub Wydruk()
wiersz = 1
kolumna = 1
Do Until Cells(wiersz + 1, kolumna).Value = ""
If Cells(wiersz, kolumna).Value = Cells(wiersz + 1, kolumna).Value Then
Cells(wiersz, kolumna + 1).Value = Cells(wiersz, kolumna).Value + Cells(wiersz, kolumna + 1).Value
Rows(wiersz + 1).Delete
ElseIf Cells(wiersz + 1, kolumna).Value = "0" Or Cells(wiersz + 1, kolumna).Value = "" Then
Rows(wiersz + 1).Delete
Else
wiersz = wiersz + 1
End If
Loop
End Sub[vbcode]
Administracja serwisu prosi o poprawienie znaczników [vbcode] |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
