vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest sobota, 12 maja 2024 roku.
Ustaw jako stronę startową Ulubione Napisz
PowrótPowrót do serwisu  RegulaminRegulamin rssRSS

  tytuł wątku:
Wątki dyskusji

marko suma.jeżeli - prośba o pomoc


otwartyotwarty rozpoczął: marta_wawa postów: 13



napisał: Trebor
postów: 1209


umieszczony:
28 marca 2012
18:36

  
nazwa pliku rozmiar
suma kolumny_T.rar 18.72 kB

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

  
nazwa pliku rozmiar
suma kolumny.xls 108.00 kB

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' latamy w pętli po wierszach
        suma = 0 'przygotowujemy zmienną pod następne dane
            For j = 3 To'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

  
nazwa pliku rozmiar
przyklad.xls 306.00 kB

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


Sortuj posty: z