napisał: Trebor postów: 1209
umieszczony: 28 marca 2012 18:36
|
|
Uzupełniony kod w załączniku |
|
napisał: marta_wawa postów: 7
umieszczony: 28 marca 2012 18:04
edytowany: 28 marca 2012 18:06
|
|
Możesz wkleić te komendy to kodu poniżej?
Mi coś źle sumuje, sumę (tzn. wartość sumy) dla komorki h7 wstawia do wszystkich niebieskich komorek :/
z góry dziękuję
Range("C65:F66").Select
ActiveCell.FormulaR1C1 = "OBRÓT BRUTTO"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Tahoma"
.FontStyle = "Pogrubiony"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("C69").Select
Range("H7").Select
Selection.Copy
Range("H8:I16").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("I7").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H18:I27").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H29:I38").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=15
Range("H40:I49").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H51:I61").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=-27
Range("L7:M16").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("L18:M27").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("L29:M38").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=15
Range("L40:M49").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=9
Range("L51:M61").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("L40:M49").Select
Range("M49").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=-9
Range("L29:M38").Select
Range("M38").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=-12
Range("L18:M27").Select
Range("M27").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("L7:M16").Select
Range("M16").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("I7").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H8:I16").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H18:I27").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=12
Range("H29:I38").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("H40:I49").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=12
Range("H51:I61").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll Down:=-54
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
ActiveWindow.SmallScroll Down:=-12
Range("C69").Select
End Sub |
|
napisał: Trebor postów: 1209
umieszczony: 27 marca 2012 19:41
|
|
Spróbuj do swojego makra wkleić na początku poniższe linie: Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Po wklejeniu formuł wykonaj polecenie:
Application.Calculate
i na samym końcu
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True |
|
napisał: marta_wawa postów: 7
umieszczony: 26 marca 2012 18:08
|
|
Witam,
jeszcze jedna prośba o makro takie jak poprzednio :)
suma.jeżeli - tylko sumująca nie wiersze ale kolumny (H69:H11068) (I69:I11068) (L69:L11068) (M69:M11068).
Suma po kolumnie D zapisująca dane w tabeli tylko w niebieskich komórkach.
Wstawione przeze mnie makro, tutaj niby działa szybko, ale przy prawdziwych danych strasznie zamula.
Z góry dziękuję :) |
|
napisał: marta_wawa postów: 7
umieszczony: 25 marca 2012 22:41
|
|
Tak
Dziękuję bardzo :) |
|
napisał: Trebor postów: 1209
umieszczony: 20 marca 2012 19:19
|
|
Czy tak wystarczy?
Sub wypelnij()
Dim i As Long, j As Long, k As Long, l As Long, kolumny As Integer, dane, dane2
i = Cells(Rows.Count, 2).End(xlUp).Row 'określenie ostatniego wiersza na podstawie 2 kolumny
dane2 = Range("A1:CB" & i) 'pobranie danych do tablicy
i = Sheets("Ilości").Cells(Rows.Count, 2).End(xlUp).Row 'określenie ostatniego wiersza na podstawie 2 kolumny
dane = Sheets("Ilości").Range("A1:CB" & i) ' pobranie danych do tablicy
l = Cells(Rows.Count, 2).End(xlUp).Row ' na początku to samo co i
For kolumny = 3 To 80 ' latamy w pętli po kolumnach
For k = 3 To l ' latamy w pętli po wierszach
suma = 0 'przygotowujemy zmienną pod następne dane
For j = 3 To i 'latamy w pętli po wierszach
'poniżej jeśli dane w obu tablicach w drugiej kolumnie są jednakowe to wartość dopisujemy do sumy
If dane(j, 2) = dane2(k, 2) Then suma = suma + dane(j, kolumny)
Next j
dane2(k, kolumny) = suma ' sumę końcową zapisujemy w tablicy
Next k
Next kolumny
Range("A1:CB" & Cells(Rows.Count, 2).End(xlUp).Row) = dane2 'dane z tablicy zapisujemy do arkusza
End Sub |
|
napisał: marta_wawa postów: 7
umieszczony: 19 marca 2012 18:13
edytowany: 19 marca 2012 18:16
|
|
Witam,
wszystko pięknie śmiga, proszę jeszcze jeśli można o komentrze do każdej linijki, co ona wykunuje.
Przerobię dzięki temu mój plik w pracy (najłtwiej byłoby bo tu oczywiście wam od początku wkleić, ale niestety tego uczynić nie mogę :/ )
Dziękuję :) |
|
napisał: Trebor postów: 1209
umieszczony: 18 marca 2012 20:59
|
|
Podmień poniższe makra (chociaż nie czuję się przekonany co do odrzucenia tabeli przestawnej)
Sub wyczysc()
Dim i As Long
Range("C3:CB" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
End Sub
Sub wypelnij()
Dim i As Long, j As Long, k As Long, l As Long, kolumny As Integer, dane, dane2
i = Cells(Rows.Count, 2).End(xlUp).Row
dane2 = Range("A1:CB" & i)
i = Sheets("Ilości").Cells(Rows.Count, 2).End(xlUp).Row
dane = Sheets("Ilości").Range("A1:CB" & i)
l = Cells(Rows.Count, 2).End(xlUp).Row
For kolumny = 3 To 80
For k = 3 To l
suma = 0
For j = 3 To i
If dane(j, 2) = dane2(k, 2) Then suma = suma + dane(j, kolumny)
Next j
dane2(k, kolumny) = suma
Next k
Next kolumny
Range("A1:CB" & Cells(Rows.Count, 2).End(xlUp).Row) = dane2
End Sub |
|
napisał: marta_wawa postów: 7
umieszczony: 18 marca 2012 20:11
edytowany: 18 marca 2012 20:16
|
|
Witam,
Potrzebne mi szybkie makro które zastąpi sumę.jeżeli a to gwarantuje podobno dim, która aż tak nie obciąża komputera.
Mam w pracy plik (nie mój - ja go tylko częściowo uzupełniam), w którym nie mogę nic zmieniać (ani w kwesti wizualnej ani strukturze)
Określona ilość wierszy, kolumn, formatowanie, nazw zakladek itd.
Po prostu wklejam na jeden arkusz dane, a na kolejnym te dane są sumowane i wstawiane w odpowiednie komórki.
Ponadto jest na tym arkuszu kilka innych makr, których nie mogę i nie chcę zmieniać.
Sposób, ktory jest zaprezentowany w przykladzie (przy prawdziwej ilości danych) zamula komputer na jakieś 5 minut (zanim dane zostaną zsumowane i wklejone jako wartości).
Podobno można tego uniknąć i zrobić to niemal natychmiast.
Proszę o pomoc :) |
|
napisał: Trebor postów: 1209
umieszczony: 18 marca 2012 19:12
edytowany: 18 marca 2012 19:14
|
|
Instrukcja Dim nie ma tu nic do rzeczy. Z pomocy excela:
"Do deklarowania zmiennej zazwyczaj stosowana jest instrukcja Dim. Instrukcja deklaracji może być umieszczona wewnątrz procedury wówczas zostanie utworzona zmienna na poziomie procedury. Jeżeli natomiast deklaracja zostanie umieszczona na początku modułu, w sekcji deklaracji, utworzona będzie zmienna na poziomie modułu."
"Jeżeli nie zostanie określony typ danych lub typ obiektu, a w module nie występuje również instrukcja Deftyp, jako domyślny przyjmowany jest typ Variant."
Wyjaśnij, z jakiego powodu to musi być makro. Tabela będzie szybsza i bardziej intuicyjna dla osoby nie znającej VBA. |
|
napisał: marta_wawa postów: 7
umieszczony: 18 marca 2012 12:13
|
|
Witam,
Potrzebuję makra z dim :)
Jeśli ktoś ma wolną chwilkę to proszę o parę linijek kodu.
Dziękuję :) |
|
napisał: Trebor postów: 1209
umieszczony: 17 marca 2012 16:00
|
|
Czy znasz tabele przestawne?
Sugeruję użyć tego narzędzia do sumowania danych. Nie będzie potrzeby zupełnie używać makr. |
|
napisał: marta_wawa postów: 7
umieszczony: 17 marca 2012 15:05
edytowany: 17 marca 2012 15:06
|
|
Witam :)
Proszę o pomoc.
Mam plik w ktorym są dwa makra na zakladce suma_ilosci.
Jedno czyści wszystkie komorki, drugie ("wypelnij") zawiera sume.jezeli która sumuje wartości dla poszczególnych liczb (sklep po sklepie)
makro "wypełnij" to jestr dosc wolne.
Wiem, że można zrobić to za pomocą funkcji "dim"
Plik ten to tylko przyklad.
Mój plik, do którego napisany przez Was kod użyję (po przerobieniu oczywiście :) jest dużo większy i znacznie wolnijeszy.
A zamula go własnie funkcja suma.jeżeli.
Prosze o makro z komendą "dim"
Jeśłi ktoś ma chwilą może w makrze zapisać komentarze, co dana linijka kodu wykonuje :)
Z góry bardzo dziękuję :)
plik w excel 2003 :) |
|
 wstecz 1 dalej  wszystkich stron: 1
|
|