Tag Archives: VBA

Loading
loading..

Dziś napiszemy o tworzeniu makr w skoroszycie makr osobistych.
Po co to robić?
Odpowiedź: aby nasze makra były dostępne w całym Excelu na danym komputerze (dla wszystkich skoroszytów Excela).

Skoro najlepiej uczyć się poprzez praktykę, to działamy… 🙂

Najpierw znajdźmy plik Personal.xlsb (czyli skoroszyt makr osobistych).

Plik Personal.xlsb powinien znajdować się w lokalizacji:

..\Users\NAZWA_UŻYTKOWNIKA\AppData\Roaming\Microsoft\Excel\XLSTART

Jeśli nie możesz znaleźć folderu AppData to włącz pokazywanie ukrytych plików i folderów:
http://windows.microsoft.com/pl-pl/windows/show-hidden-files#show-hidden-files=windows-7

Nie masz pliku PERSONAL?
Jeśli w powyżej lokalizacji nie ma pliku Personal.xlsb to należy najpierw nagrać makro. Plik ten powstaje w momencie zarejestrowania makra. Podczas rejestracji musimy wskazać miejsce przechowywania makr na „skoroszyt makr osobistych””.

W tym celu otwórzmy sobie nowy skoroszyt Excela.

W tym momencie powinniśmy mieć otwartego Excela i aby nagrać makro należy kliknąć w lewym dolnym rogu na przycisk nagrywanie makr.

nagrywanie

W tym momencie powinno nam się otworzyć okienko Rejestrowanie makra

Rejestrowanie

W Przechowuj makro w: wybieramy opcję Skoroszyt makr osobistych. Tak jak jest to zrobione na poniższym obrazku. Ponadto możemy nadać skrót wpisując w Klawisz skrótu np. dużą literę C. Następnie klikamy OK.

W tym momencie możemy nagrywać makro, więc wszystko co teraz zrobimy w Excelu będzie nagrywane aż do momentu zatrzymania rejestrowania makra. Przykładowo zmieńmy kolor zaznaczonej komórki na czerwono i zatrzymajmy nagrywanie makra klikając w to samo miejsce gdzie włączaliśmy nagrywanie makra.

zatrzym

Udało nam się nagrać makro w skoroszycie makr osobistych, teraz możemy zamknąć plik excela. Przy zamykaniu powinno nam się pojawić okno:

okno

Kliknijmy Zapisz

W tym momencie powinien utworzyć się plik Personal.xlsb. Możemy to sprawdzić poprzez ponowne otwarcie poniższej lokalizacji (oczywiście na waszym komputerze początek ścieżki może się różnić).

..\Users\NAZWA_UŻYTKOWNIKA\AppData\Roaming\Microsoft\Excel\XLSTART

Co więcej teraz gdy otworzymy jakikolwiek plik Excela to podczas pracy możemy użyć skrótu Ctrl+Shift+C.

Właśnie zostaliśmy developerem Excela 🙂
Pozdrawiamy i do następnego wpisu 🙂

Czasami pojawiały się pytania o funkcję „oczyszczającą”, która w tekście zostawiałaby wskazane przez nas znaki a pozostałe usuwała. Po tych pytaniach postanowiliśmy umieścić taką funkcję na blogu, aby ułatwić Wam pracę.:)

Przedstawiona poniżej funkcja pozostawia w tekście znaki, które są wskazane w drugim argumencie funkcji. Jako argument możemy podać ciąg znaków i tak np. jeśli wpiszemy poniższą formułę:

=Pozostaw(„Ala ma kota!”; „ma „)

to funkcja usunie wszystkie znaki poza m, a, oraz spacją. Wynikiem działania będzie „Aa ma a”


Function Pozostaw(PrzeszukiwanyTekst As String, Znak As String) As String
    'Funkcja pozostawia w tekście znaki, które są podane w drugim argumencie
    Dim Z As String
    Dim i As Long
    Dim NumerZnaku As Long
    For i = 1 To Len(PrzeszukiwanyTekst)
        NumerZnaku = NumerZnaku + 1
        Z = Mid(PrzeszukiwanyTekst, NumerZnaku, 1)
        If Not UCase(Znak) Like "*" & UCase(Z) & "*" And Z <> "" Then
            PrzeszukiwanyTekst = Replace(PrzeszukiwanyTekst, Z, "")
            NumerZnaku = NumerZnaku - 1
        End If
    
    Next
    
    Pozostaw = PrzeszukiwanyTekst
End Function

Jeśli nie wiesz jak wkleić powyższą funkcję to zapraszamy do wpisu jak zacząć pierwsze makro.
Wystarczy skopiować i wkleić powyższy kod a już będziemy mogli korzystać z formuły Podstaw.


Inne przykłady wykorzystania funkcji Pozostaw

Funkcja pozostaw może nam się np. przydać jeśli mamy podany serię i numer dowodu, a chcemy je oddzielić.
Przykładowo: ABS123456

Chcemy jednak wyciągnąć tylko cyfry z podanego ciągu. Wystarczy, że wywołamy funkcję

Pozostaw(„ABS123456″;”0123456789”)

Oczywiście jako argumenty funkcji możemy podawać odwołania do komórek.

Omówimy sposób pobierania nazwy pliku ze ścieżki z wykorzystaniem różnych opcji.

W ostatnim wpisie poruszyliśmy kwestię pobierania ścieżki za pomocą metod: GetOpenFilename oraz GetSaveAsFilename, ale co zrobić jeśli następnie chcemy pobrać samą nazwę pliku?

Link do poprzedniego wpisu: http://heap.pl/pobieranie-sciezki-pliku/

Istnieje kilka możliwości, aby pobrać nazwę pliku ze ścieżki. Proponowane przeze mnie w tym wpisie to:

1) użycie funkcji InStrRev, wyszukanie za jej pomocą ukośnika (ostatniego od prawej strony)
2) wykorzystanie funkcji Split (podział po ukośnikach) a następnie znalezienie ostatniego elementu
3) użycie funkcji DIR

W naszym przykładzie wpisaliśmy ścieżkę do pliku postaci: „C:\Users\Documents\makro\makro.xlsx”.


1) – użycie funkcji InStrRev

Sub PobierzNazwePliku()
    Dim NazwaPliku As String
    Dim Sciezka As String
    Sciezka = "C:\Users\Documents\makro\makro.xlsx"
    NazwaPliku = Right(Sciezka, Len(Sciezka) - InStrRev(Sciezka, "\"))
End Sub

Funkcja Right() zwraca określoną liczbę znaków od końca ciągu tekstowego. Jako argument podajemy ścieżkę, oraz wykorzystujemy funkcję InStrRev, aby określić liczbę znaków od prawej strony. InStrRev zwraca pozycję na której znajduje się ostatni ukośnik.

Jeśli chcemy usunąć rozszerzenie, to wystarczy użyć funkcji Mid()

Sub PobierzNazwePliku()
    Dim NazwaPliku As String
    Dim Sciezka As String
    Sciezka = "C:\Users\Documents\makro\makro.xlsx"
    NazwaPliku = Mid(Sciezka, InStrRev(Sciezka, "\") + 1, InStrRev(Sciezka, ".") - InStrRev(Sciezka, "\") - 1)
End Sub


opcja 2) – wykorzystanie funkcji Split

Funkcja VBA Split jest funkcją rozdzielającą łańcuch znaków.

Argumenty wejściowe Split() to:

  • Expression – wyrażenie do rozdzielenia
  • Delimiter – separator – znak rozdzielający (argument opcjonalny, wartość domyślna to spacja).
  • Limit – ilość pojedynczych łańcuchów wydzielonych z wyrażenia. Argument opcjonalny (wartość domyślna -1, zwracając wszystkie).
  • Compare – tryb porównania ciągów. Dla porównania tekstowego – wartość 1. (dla wartości domyślnej 0 – porównanie binarne).

Funkcja zwraca wartość tablicową. Poszczególne elementy tablicy indeksowane są począwszy od wartości. Podobny efekt jak funkcja

Zwracana przez funkcję Split wartość jest wartością tablicową. Poszczególne elementy są indeksowane począwszy od wartości zero.

Sub PobierzNazwePliku()
    Dim NazwaPliku As String
    Dim TabElementy() As String
    Dim Sciezka As String
    Sciezka = "C:\Users\Documents\makro\makro.xlsx"
    
    TabElementy() = Split(Sciezka, "\")
    NazwaPliku = TabElementy(UBound(TabElementy()))
End Sub

W powyższym przykładzie funkcja split() rozdziela ścieżkę po ukośniku. W efekcie zwraca nam tablicę, gdzie ostatnim elementem jest nazwa pliku wraz z rozszerzeniem. Dlatego użyliśmy polecenia Ubound() aby sprawdzić wielkość tablicy i zwrócić jej ostatni element.


opcja 3) – użycie funkcji DIR.

Jest jedną z bardziej popularnych metod, ale nie jest to wcale najlepszy sposób. Dlaczego?
1. Działa wolno, bo zawsze przeszukuje dysk.
2. Plik musi istnieć, aby działała poprawnie.
3. Jest niestabilna (jeśli tworzymy pętlę po wszystkich plikach danego folderu, to takie wywołanie dir zniszczy tę pętle)
4. Nie zadziała poprawnie jeśli plik jest ukryty

Jako argument funkcji Dir wpisujemy ścieżkę do pliku.
Przykład:

Sub PobierzNazwePliku()
    Dim NazwaPliku As String
    NazwaPliku = Dir("C:\Users\Documents\makro\makro.xlsx")
End Sub

Co ważne polecenie Dir zwróci nazwę pliku wraz z rozszerzeniem tylko wtedy gdy plik istnieje w podanym katalogu. Dlatego aby powyższy przykład zadziałał musimy najpierw stworzyć plik makro.xlsx w katalogu makro (C:\Users\Documents\makro\). Wtedy funkcja zwróci łańcuch marko.xlsx. Jeżeli plik nie istnieje lub w podanej ścieżce jest błąd to funkcja zwróci pusty łańcuch znaków.

Przykład z poprzedniego wpisu
Link do poprzedniego wpisu: http://heap.pl/pobieranie-sciezki-pliku/

Poniżej prezentujemy przykład z poprzedniego wpisu, ale tym razem dodamy linijkę gdzie wykorzystany będzie sposób 1 aby pobrać nazwę pliku.

Sub PobierzNazwePliku4()
    Dim NazwaPliku As Variant
    Dim FileFilter  As String
    Dim FilterIndex  As Integer
    Dim Title As String
    
    FileFilter = "Pliki Excel (*.xlsx;*.xls),*xlsx;*.xls," & _
    "Pliki Excel XLSX (*.xlsx),*.xlsx," & _
    "Pliki Excel 97-2003 (*.xls),*.xls," & _
    "Wszystkie pliki (*.*),*.*"
    
    FilterIndex = 4 'Wybieramy domyślny filtr. 4 oznacza że domyślnie wybieramy filtr Wszystkie pliki (*.*)
    Title = "Otwórz plik Excela"
    
    NazwaPliku = Application.GetOpenFilename(FileFilter, FilterIndex, Title)
    
    'Wyświetlenie  MessageBox, jeśli w oknie dialogowym zostanie naciśnięty przycisk Anuluj
    If NazwaPliku = False Then
        MsgBox "Nie wybrano żadnego plikU."
        Exit Sub
    End If
    
    NazwaPliku = Right(NazwaPliku, Len(NazwaPliku) - InStrRev(NazwaPliku, "\"))
End Sub

To tyle na dziś. 🙂

Po przeczytaniu tego wpisu będziesz wiedział jak w łatwy sposób pobrać pełną ścieżkę pliku. Do tego celu można wykorzystać metodę GetOpenFilename obiektu Application lub metodę GetSaveAsFilename obiektu Application.

Metoda GetOpenFilename wyświetla dobrze wszystkim znane okno dialogowe Otwieranie, gdzie wskazujemy folder oraz wybieramy plik, który nas interesuje.
okno otwierania

Co ważne metoda ta nie otwiera wskazanego pliku a jedynie pobiera jego ścieżkę oraz nazwę i zwraca jako łańcuch znaków.

Poniżej przykład implementacji metody GetOpenFilename

Sub PobierzSciezkePliku()
    Dim SciezkaPliku As Variant 'Deklaracja zmiennej, która będzie przechowywać ścieżkę pliku
    Dim FileFilter As String 'Deklaracja zmiennej, która będzie argumentem FileFilter
    
    FileFilter = "Pliki Excel XLSX (*.xlsx),*.xlsx," 'Tutaj podajemy łańcuch określający kryterium filtrowania plików
    
    SciezkaPliku = Application.GetOpenFilename(FileFilter) 'Otwarcie okna dialogowego Otwieranie oraz pobranie ścieżki pliku do zmiennej
End Sub

Wszystkie argumenty metody GetOpenFilename są opcjonalne.

Application.GetOpenFilename(FileFilter, FileIndex, Title, ButtonText, MultiSelect)

FileFilter – argument ten określa co pojawi się na liście rozwijanej okna dialogowego Otwieranie. Jeżeli pominiemy ten argument to w oknie będą wyświetlane Wszystkie pliki. Jest to równoznaczne z podaniem argumentu „Wszystkie pliki (*.*),*.*

W powyższym przykładzie wyświetlamy tylko pliki formatu .xlsx. Argument FileFilter jest równy: „Pliki Excel XLSX (*.xlsx),*.xlsx,”
Pierwsza część łańcucha: Pliki Excel XLSX  definiuje jaki tekst będzie wyświetlany na liście rozwijanej Pliki typu. Druga część: (*.xlsx),*.xlsx, określa jakie pliki zostaną wyświetlone w oknie (tylko o formacie .xlsx).

FilterIndex – argument ten definiuje domyślne kryterium filtrowania plików (Ma to znaczenie w przypadku gdy FileFilter posiada więcej niż jedno kryterium. Poniżej jest zaprezentowany przykład gdy argument FileFilter składa się z 3 kryteriów).

Title – tytuł okna dialogowego (jesli zostanie pominięty, tytułem będzie łańcuch Otwieranie

ButtonText – argument stosowany tylko w przypadku systemu Macintosh

MultiSelect – jeżeli argument ma wartość True, wybranych może być więcej niże jeden plik. Wartością domyślną jest False (możliwość wybierania tylko jednego pliku). Gdy argument będzie równy True to metoda GetOpenFilename będzie zwracać tablicę.

Poniżej przykład gdy mamy 3 kryteria filtrowania plików:

Sub PobierzSciezkePliku()
 Dim SciezkaPliku As Variant
 Dim FileFilter As String
 
 FileFilter = "Pliki Excel (*.xlsx;*.xls),*xlsx;*.xls,"
 "Pliki Excel XLSX (*.xlsx),*.xlsx,"
 "Pliki Excel 97-2003 (*.xls),*.xls,"
 
 SciezkaPliku = Application.GetOpenFilename(FileFilter)
End Sub

Następnie spróbujmy zdefiniować 4 kryteria filtrowania plików, ustawić czwarte kryterium jako domyślne i zmienić tytuł okna dialogowego.

Sub PobierzSciezkePliku()
    Dim SciezkaPliku As Variant
    Dim FileFilter  As String
    Dim FilterIndex  As Integer
    Dim Title As String
    
    FileFilter = "Pliki Excel (*.xlsx;*.xls),*xlsx;*.xls," & _
    "Pliki Excel XLSX (*.xlsx),*.xlsx," & _
    "Pliki Excel 97-2003 (*.xls),*.xls," & _
    "Wszystkie pliki (*.*),*.*"
    
    FilterIndex = 4 'Wybieramy domyślny filtr. 4 oznacza że domyślnie wybieramy filtr Wszystkie pliki (*.*)
    Title = "Otwórz plik Excela"
    
    SciezkaPliku = Application.GetOpenFilename(FileFilter, FilterIndex, Title)
    
    'Wyświetlenie  MessageBox, jeśli w oknie dialogowym zostanie naciśnięty przycisk Anuluj
    If SciezkaPliku = False Then
        MsgBox "Nie wybrano żadnego plikU."
        Exit Sub
    End If
End Sub

Metoda GetSaveASFilename jest prawie identyczna jak metoda GetOpenFilename. Różnica jest taka, że wyświetla ona okno dialogowe Zapisywanie jako i umożliwia wybranie pliku lub podanie nazwy pliku. Funkcja również zwraca ścieżkę pliku wraz z nazwą i nie podejmuje żadnej akcji. Wszystkie argumenty tej funkcji są opcjonalne. Argument InitialFilename pozwala określić sugerowaną nazwę pliku (wraz ze ścieżką do pliku).

Poniżej zadania, które pomocą Ci poćwiczyć sprawniejsze posługiwanie się pętlami.

Zadania powinny być uniwersalne w każdym języku imperatywnym
Czyli niezależnie od tego jakiego języka programowania się uczysz, zadania powinny być rozwiązywalne. ( C, C++, C#, JAVA, JavaScript, VBA, Ruby, Python)

Zadania na wykorzystanie pętli

Napisz funkcję/procedurę/metodę, której wywołanie pozwoli na:

  1. wypisz liczby od 1 do 100
  2. wypisz liczby od 8 do 50
  3. wypisz liczby parzyste od 2 to 50
  4. wypisz liczby od 100 do 1
  5. wypisz liczby podzielne przez 8 ( w zakresie 1..100)
  6. wypisz liczby podzielne przez 3 lub 5 ( w zakresie 1..100)
  7. wypisz liczby podzielne przez 3 albo 5 ( w zakresie 1..100) (nie wypisuj tych podzielnych jednocześnie przez 3 i 5)
  8. wypisz największą liczbę niepodzielną przez 2,3,5,7 ale mniejszą od 1000
  9. sprawdź czy podana jako parametr liczba jest parzysta
  10. sprawdź czy podana jako parametr liczba jest liczbą pierwszą. (podzielna tylko przez 1 i przez samą siebie) (opis tutaj
  11. wylicz największy wspólny dzielnik 2 liczb podanych jako parametry (opis tutaj)
  12. wylicz najmniejszą wspólną wielokrotność liczb podanych jako parametry (opis tutaj)
  13. ile jest liczb pierwszych w zakresie od a do b podanym jako parametry
  14. sprawdź czy 2 liczby podane jako parametr są liczbami względnie pierwszymi. (opis tutaj)
  15. sprawdź czy pesel ( jako parametr) jest prawidłowym peselem (tutaj opis)
  16. oblicz silnię n (n – podane jako parametr) (tutaj opis)
  17. oblicz n-tą liczbę ciągu fibonacciego (n – podane jako parametr) (tutaj opis)
  18. oblicz n-tą liczbę pierwszą (n – podane jako parametr)

Wszystkie rozwiązania mile widziane, umieszczę pod zadaniami.
Jak będziesz miał jakieś pytania, któreś z zadań będzie za trudne do rozwiązania, to pisz na maila, spróbuję podpowiedzieć i wytłumaczyć.

Powodzenia!

Dzisiaj stworzysz makra, które będą pozwalały scalić lub rozcalić odpowiednie komórki, dzięki czemu automatycznie będziesz mógł przekonwertować komórki na scalone, lub szybko pozbędziesz się scalonych komórek (np. żeby zrobić tabelę przestawną).
Najszybciej pokaże to poniższy rysunek:
scalanie_rozcalanie
Lewa tabelka przyda się do wszelkich analiz, formatowania, tabel przestawnych. Prawa tabelka przyda się jeśli będziesz chciał wydrukować dane lub w elegancki sposób przesłać jakiś raport.

Jeszcze jeden warunek. Żeby nasze makro było uniwersalne zróbmy, by działało tylko na ZAZNACZONYCH komórkach.

Rozdzielanie komórek

Do dzieła! Zacznijmy od rozcalania / rozdzielania ( czyli z lewej na prawą).

Do uzyskania zamierzonego efektu wystarczy makro implementujące prosty algorytm:
1. Ustaw się na pierwszej komórce w zaznaczeniu.
2. Jeśli jest wypełniona to zapamiętaj czym jest wypełniona
3. Jeśli jest pusta, to wpisz to co poprzednio zapamiętałeś
4. Przejdź do następnej komórki i wróć do punktu 2.

Implementacją tego będzie prosta procedura:

Sub rozcalZaznaczenie()
  Selection.UnMerge    ' usuwa scalenie z zaznaczonych komórek

  ' pozostało jeszcze uzupełnić puste komórki:
  Dim komorka As Range  ' definiujemy zmienną komórka
  Dim poprzednia        ' tu będziemy zapamiętywać poprzednią komórkę
 
  'pętla:
  For Each komorka In Selection ' Dla każdej komórki w zaznaczeniu:
    If komorka = "" Then ' jeśli komórka jest pusta
      komorka = poprzednia ' wpisz to co poprzednio zapamiętałeś     
    Else ' w przeciwnym przypadku, czyli jeśli komórka jest wypełniona
      poprzednia = komorka  ' to zapamiętaj zawartość komórki, bo
                        'może się przydać do wypełnienia następnej komórki
    End If
  Next komorka ' przejdź do następnej komórki
End Sub ' koniec procedury

starałem się wszystko opisać w komentarzach.

Scalanie komórek

Teraz chcielibyśmy uzyskać efekt odwrotny. Mamy dużo komórek, które nie są scalone, ale powtarzające się komórki ustawione są koło siebie ( np. poprzez sortowanie).
Najprostrzy algorytm będzie działał w ten sposób:

1. Zapamiętaj pierwszą komórkę z zaznaczenia na nazwie P
2. Ustaw się na pierwszej komórce w zaznaczeniu.
3. Jeśli komórka jest taka sama co komórka P to przejdź do pkt. 2.
4. Jeśli komórka różni się od komórki P (to znaczy, że skończył się blok, trzeba scalić komórki), to:
a) scal komórki powyżej naszej komórki aż do P
b) aktualną komórkę zapamiętaj jako P
c) idź do pkt 2.

Implementacja:

Sub scalanie()
  Dim P As Range ' deklaracja zmiennej P
  Dim komorka As Range ' deklaracja komórki
  Set P = Selection.Cells(1, 1)       ' zapamiętaj pierwszą komórkę z zaznaczenia
  For Each komorka In Selection       ' dla każdej komórki w zaznaczeniu  
    If komorka <> P Then              ' jeśli komórka jest inna niż P
      Range(komorka.Offset(-1, 0), P).Merge ' scal powyżej komórki do P
      Set P = komorka                       ' zapamiętaj komórkę
    End If      
  Next komorka  ' przejdź do następnej komórki
End Sub

Jest prawie dobrze, ale…

Nie do końca działa tak jak chcemy.
Po pierwsze przed każdym scaleniem pojawiają się alerty / komunikaty: „Czy na pewno chcesz scalić komórki?”. Fajnie byłoby, żeby Excel nie pytał się nas o wszystko;)
W tym celu użyjemy polecenia:

  Application.DisplayAlerts = False   ' wyłączenie komunikatów

Po wykonaniu naszego makra warto byłoby włączyć z powrotem alerty / komunikaty:

  Application.DisplayAlerts = True ' włączenie komunikatów

Zauważyłeś pewnie, że makro nie działa dla ostatniej sekcji ( dla ostatniego miasta). To dlatego, że scalamy zawsze komórki powyżej aktualnie przetwarzaną i w ten sposób makro kończy się na komórce która powinna być scalona, ale nie zdąży już jej scalić.
Jednym z pomysłów jest zaznaczać zakres z komórką o jeden niżej.
Drugim : Po co masz pamiętać, żeby zaznaczać komórkę o jedną więcej, jak makro samo może to zrobić?

Pomocna będzie funkcja RESIZE, która potrafi zmienić rozmiar danego zakresu.
Jeśli chcesz otrzymać zakres rozpoczynający się tu gdzie nasz zakres, ale o rozmiarach 15 wierszy na 2 kolumny, to piszesz:

     Selection.Resize(15, 2)

Jeśli chcesz zaznaczeni powiększyć o 1, to musimy znać poprzedni rozmiar, czyli:

  Selection.Rows.Count ' liczba wierszy
  Selection.Columns.Count ' liczba kolumn

Łącząc oba spostrzeżenia możesz napisać:

  Selection.resize(Selection.Rows.Count + 1, 1)    ' o jeden wiersz więcej

przyda się jeśli dane będą w pionie
Gdy dane będą w poziomie przyda się:

  Selection.resize(1, Selection.Columns.Count + 1) ' o jedną kolumnę więcej

Zastosujemy tutaj dodatkową zmienną „zakres”:

If Selection.Rows.Count = 1 Then ' jeśli zakres w poziomie ( 1 wiersz )
  Set zakres = Selection.Resize(1, Selection.Columns.Count + 1) ' to rozciągnij w poziomie
Else                             ' jeśli w pionie (więcej wierszy)
  Set zakres = Selection.Resize(Selection.Rows.Count + 1, 1) ' to rozciągnij w pionie
End If

Cały kod będzie wyglądał tak:

Sub scalanie()
  Dim P As Range ' deklaracja zmiennej P
  Dim komorka As Range ' deklaracja komórki
  Dim zakres As Range  ' tutaj zapamiętamy nasz zakres, który chcemy przetwarzać.
 
  Application.DisplayAlerts = False   ' wyłączenie komunikatów
  Set P = Selection.Cells(1, 1)       ' zapamiętaj pierwszą komórkę z zaznaczenia
 
  If Selection.Rows.Count = 1 Then ' jeśli zakres w poziomie ( 1 wiersz )
  Set zakres = Selection.Resize(1, Selection.Columns.Count + 1) ' to rozciągnij w poziomie
  Else                             ' jeśli w pionie
  Set zakres = Selection.Resize(Selection.Rows.Count + 1, 1)
  End If
 
  For Each komorka In zakres       ' dla każdej komórki w zaznaczeniu + komórka o jeden dalej
    If komorka <> P Then              ' jeśli komórka jest inna niż P
      Range(komorka.Offset(-1, 0), P).Merge ' scal powyżej komórki do P
      Set P = komorka                       ' zapamiętaj komórkę
    End If
  Next komorka  ' przejdź do następnej komórki
  Application.DisplayAlerts = True ' włączenie komunikatów
End Sub

W razie pytań, pisz śmiało w komentarzach lub na maila.
Mile widziane Like na Facebooku lub +1 na GPlus

Życzę wytrwałości w pogłębianiu wiedzy!

Zadania

1. Napisz funkcję, która pobierze datę i zwróci nazwę dnia tygodnia.
2. Makro, która wszystkie zaznaczone komórki zamieni na wartości tekstowe
3. Napisz makro, które dla zaznaczonych komórek wyliczy ile z tych komórek zawiera liczby.
4. Napisz makro, które ukryje wszyztkie arkusze poza pierwszym.
5. Napisz makro, które pokaże arkusz pierwszy, a wszystkie pozostałe ukryje.
6. Napisz makro, które dla zaznaczonych komórek kolorem czerwonym pokoloruje błędy a kolorem niebieskim pokoloruje tekst. (pozostałe komórki nie powinny być zmieniane)
7. Napisz funkcję, która przyjmuje liczbę (lub tekst) i liczy ile razy występuje w całym pliku ( we wszystkich arkuszach).
7*. Jak wyżej, ale zrób to bez użycia pętli (będzie działać szybciej)
8. Napisz funkcję, która dla polskiego numeru rachunku bankowego odpowie, czy długość i cyfra kontrola zgadza się.
Zrób tak, aby funkcja działała zarówno dla numerów ze spacjami jak i bez spacji.
Na wikipedii możesz znaleźć sposób wyliczania cyfr kontrolnych. kliknij tutaj

Rozwiązania

Wkrótce…

Spróbuj samodzielnie zrobić poniższe zadania (rozwiązania znajdziesz poniżej)

1. W komórce A1 znajduje się liczba. Wpisz w komórkach od A5 tyle liczb ile wynosi A1
2. Napisz makro, które ustawi formatowanie liczbowe z 2 miejscami po przecinku w kolumnie A, formatowanie tekstowe w kolumnie B, a formatowanie daty w kolumnie C. I autodopasuje wszystkie kolumny
3. Napisz makro, które wpisuje kolejnych 50 liczb po przekątnej (A1, B2, C3, D4, itd)
4. Napisz makro, zapyta się o liczbę i pokoloruje tyle komórek ile podał użytkownik
5. Napisz makro, które pokoloruje liczby ujemne w zaznaczonych komórkach
6. Napisz funkcję, która na podstawie daty sprawdzi, czy to był „weekend” czy „dzień tygodnia”
7. Napisz funkcję, która przyjmuje 3 liczby jako parametry i wyświetli największą z nich
8. Napisz funkcję, która przyjmuje 2 liczby jako parametry i wyświetla mniejszą z nich, (ale większą od zera). Jeśli żadna liczba nie jest dodatnie, to wyświetli 0
9. Napisz funkcję, która przyjmuje 3 liczby jako parametry i wyświetla mniejszą z nich, (ale większą od zera). Jeśli żadna liczba nie jest dodatnie, to wyświetli 0
10. Napisz makro, które dla zaznaczonych komórek policzy ich sumę i wyświetli ją w msgboxie
11. Napisz makro, które w kolumnie A w pierwszej wolnej komórce wyświetli podsumowanie wszystkich liczb znajdujących się powyżej

 Rozwiązania

1. W komórce A1 znajduje się liczba. Wpisz w komórkach od A5 tyle liczb ile wynosi A1

Sub Zad1()
   Dim Liczba As Long 'Deklaracja zmiennej liczba jako całkowita długa
   Dim Komorka As Range ' Deklaracja zmiennej określającej pojedynczą komórkę obszaru
   Liczba = Range("A1").Value 'Przypisanie zmiennej liczba wartości z komórki A1
   For Each Komorka In Range("A5:A" & 5 + Liczba - 1)
      Komorka = Rnd 'Funkcja Rnd (funkcja wbudowana w VBA) zwraca losową liczbę z zakresu od 0 do 1
   Next
End Sub

2. Napisz makro, które ustawi formatowanie liczbowe z 2 miejscami po przecinku w kolumnie A, formatowanie tekstowe w kolumnie B, a formatowanie daty w kolumnie C. I autodopasuje wszystkie kolumny

Sub Zad2()
   Columns("A:A").NumberFormat = "0.00"
   Columns("B:B").NumberFormat = "@"
   Columns("C:C").NumberFormat = "m/d/yyyy"
   Columns("A:C").EntireColumn.AutoFit
End Sub

3. Napisz makro, które wpisuje kolejnych 50 liczb po przekątnej (A1, B2, C3, D4, itd)

Sub Zad3()
   Dim i As Long
   For i = 1 To 50
      Cells(i, i) = i
   Next
End Sub

4. Napisz makro, zapyta się o liczbę i pokoloruje tyle komórek ile podał użytkownik

Sub Zad4()
   Dim Liczba As Long
   Liczba = InputBox("Podaj liczbę całkowitą", "Komunikat")
   Range("A1:A" & Liczba).Interior.Color = rgbOrange
End Sub

5. Napisz makro, które pokoloruje liczby ujemne w zaznaczonych komórkach

Sub Zad5()
   Dim Komorka As Range
   For Each Komorka In Selection
      If Komorka.Value &lt; 0 Then
         Komorka.Interior.Color = rgbRed
      End If
   Next
End Sub

6. Napisz funkcję, która na podstawie daty sprawdzi, czy to był „weekend” czy „dzień tygodnia”

Function CzyWeekend(Data As Date) As Boolean
   If Weekday(Data, vbMonday) &gt; 5 Then
      CzyWeekend = True 'Weekend
   Else
      CzyWeekend = False 'Dzień roboczy
   End If
End Function

lub lepiej:

Function CzyWeekend(Data As Date) As Boolean
   CzyWeekend = Weekday(Data, vbMonday) &gt; 5
End Function

7. Napisz funkcję, która przyjmuje 1 liczby jako parametry i wyświetli największą z nich

Function Najwieksza(Liczba1 As Variant, Liczba2 As Variant, Liczba3 As Variant) As Variant
    If Liczba1 > Liczba2 And Liczba1 > Liczba3 Then
        Najwieksza = Liczba1
    ElseIf Liczba2 > Liczba3 Then
        Najwieksza = Liczba2
    Else
        Najwieksza = Liczba3
    End If
End Function

W VBA można korzystać z funkcji arkuszowych Excela. Przykładem funkcji arkuszowej jest znana funkcja Max (Maksimum). W VBA możemy z niej skorzystać za pomocą obiektu Application.WorksheetFunction, czyli po prostu wpisując w funkcji Application.WorksheetFunction a następnie wybierając funkcje Max.

Function Max(Liczba1 As Double, Liczba2 As Double, Liczba3 As Double) As Double
   Max = Application.WorksheetFunction.Max(Liczba1, Liczba2, Liczba3) 
End Function

8. Napisz funkcję, która przyjmuje 2 liczby jako parametry i wyświetla mniejszą z nich, (ale większą od zera). Jeśli żadna liczba nie jest dodatnie, to wyświetli 0

Function MniejszaDodatnia(Liczba1 As Double, Liczba2 As Double) As Double
   If Liczba1 &lt; 0 And Liczba2 &lt; 0 Then
      MniejszaDodatnia = 0
   ElseIf Liczba1 &lt; 0 And Liczba2 &gt; 0 Then
      MniejszaDodatnia = Liczba2
   ElseIf Liczba1 &gt; 0 And Liczba2 &lt; 0 Then
      MniejszaDodatnia = Liczba1
   Elseif Liczba1 &lt; Liczba2 Then
      MniejszaDodatnia = Liczba1
   Else
      MniejszaDodatnia = Liczba2
   End If
End Function

9. Napisz funkcję, która przyjmuje 3 liczby jako parametry i wyświetla mniejszą z nich, (ale większą od zera). Jeśli żadna liczba nie jest dodatnie, to wyświetli 0

10. Napisz makro, które dla zaznaczonych komórek policzy ich sumę i wyświetli ją w msgboxie

Sub Zad10a()
   Dim Suma As Double
   Dim Komorka As Range
   For Each Komorka In Selection
      Suma = Suma + Komorka.Value
   Next
   MsgBox ("SUMA=" & Suma)
End Sub

albo bez pętli:

Sub Zad10b()
   msgbox(worksheetfunction.sum(activecell.resize(activecell.end(xlDown).row - activecell.row+1, 1).address & ")"
End Sub

11. Napisz makro, które w kolumnie A w pierwszej wolnej komórce wyświetli podsumowanie wszystkich liczb znajdujących się powyżej

Sub Zad11a()
   Dim wiersz As Long
   Dim Suma As Double
   wiersz = 1
   While ActiveCell.Cells(Wiersz, "A") &lt;&gt; ""
      Wiersz = Wiersz + 1
   Wend
   ActiveCell.Cells(Wiersz, "A").Formula = "=SUM(" & ActiveCell.resize(wiersz, 1).Address(False, False) & ")"
End Sub

albo bez pętli:

Sub Zad11b()
   dim miejsce as range
   set miejsce = activecell.end(xlDown).offset(1, 0)
   miejsce.formula = "=sum(" & activecell.resize(miejsce.row - activecell.row, 1).address & ")"
End Sub

Przygotowania do tworzenia makr i proste makra w MS Excel

Przygotowania, czyli pokazanie karty developer na wstążce

Po pierwsze będzie nam potrzebna karta delevoper na wstążce( zakładam, że używamy wersji 2007 lub 2010).
Znajdują się na niej polecenia pomocne przy tworzeniu makr i kontrolek na Arkuszu.

karta developer

W wersji 2007: wybieramy Przycisk Office(ten okrągły) -> opcje programy Excel -> Zaznaczamy haczyk przy „pokaż kartę developer na wstążce”
W wersji 2010: wybieramy Plik -> opcje -> dostosowywanie wstążki -> po prawej stronie zaznaczamy haczyk przy karcie developer
Powinniśmy uzyskać efekt:

wstążka zaznaczony developer

Do dzieła! Piszemy nasze pierwsze makro.

Napiszemy makro, które wyświetli nam komunikat z przywitaniem.
W tym celu klikamy wstążkę developer -> Makra

W polu nazwa makra wpisujemy „pierwszeMakro”
Nazwa makra musi być nazwą kwalifikowaną, czyli taką która składa się z samych liter, liczb i znaków podkreślenia oraz musi zaczynać się od litery.
Warto pisać nazwy makr bez polskich liter ( np. Excel w niemieckiej czy angielskiej wersji nie zawsze dobrze radzi dobie z polskimi nazwami).
Po wpisaniu prawidłowej nazwy klikamy przycisk UTWÓRZ.

Otworzy nam się nowe okno VBE (Visual Basic Editor).
kurs VBA cz0 opis okna

Standardowe okno dzieli się na 3 części. W górnej prawej części ekranu znajduje się okno PROJECT – jest to okno nawigacji po projekcie. Tym projektem jest nasz plik Excelowy.
Tutaj widzisz wszystkie arkusze (tak, to są te arkusze z Excela). Każdy arkusz ma dwie nazwy. Ta w nawiasie to nazwa Excelowa. (Spróbuj w Excelu zmienić nazwę arkusza zobacz, że zmieniła się także nazwa nawiasie w oknie Project).
W dolnym lewy oknie arkusza znajduje się okno Properties. W tym oknie znajdziesz właściwości elementu który zaznaczysz w oknie Project.
Większą część okna zajmuje edytor.

W oknie edytora wpiszemy nasze pierwsze marko:

sub pierwszeMakro
msgbox(„Witaj świecie”)
end sub

UWAGA1: VBA nie rozróżnia wielkości liter. Najlepiej wszystko co nie jest w cudzysłowie wpisywać małymi literami.
Po naciśnięciu Enter, lub po przejściu do nowej linijki VBA poprawi nam literki na duże. (Jeśli nie zrobiliśmy literówki)
UWAGA2: nie bój się eksperymentować z programowaniem w VBA. Zmień fragment kodu i sprawdź czy zadziała.

linijka 1:
pierwsza linijka to słówko SUB.
Dzięki niemu VBA wie, że chcemy zacząć pisać procedurę.
po nim następuje nazwa makra. Może być to dowolna nazwa klalifikowana. (czyli w grę wchodzą tylko litery, cyfry i podkreślenia. Oraz dodatkowo musi rozpoczynać się literą).

linijka 2:
MSGBOX (skrót od Message Box) to funkcja, dzięki której możemy wyświetlić komunikat w oddzielnym okienku z przyciskiem OK. Na pewno widziałeś już takie okna w Windowsie.
Oczywiście zawartość cudzysłowu możesz dowolnie zmieniać.

linijka 3:
Tutaj komunikujemy VBA, że w tym momencie kończy się nasz procedura.

UWAGA3: makro możesz edytować/dodawać/usuwać bezpośrednio z edytora VBA.
Aby dodać makro pod już istniejącym wpisujesz nowe.
Np mój moduł wygląda tak:

sub pierwszeMakro
msgbox(„Witaj świecie”)
end sub

sub aktualnaData
msgbox(„Dzisiaj jest ” & date )
end sub

Znaczek & popularnie zwany AND (a tak na prawdę ampersand) łączy dwa napisy. Tak samo działa w Excelu! Sprawdź, co zrobi formuła =A1&” — „&dziś() wpisana w komórkę A2. I wpisz coś w komórkę A1.
Funkcja DATE w VBA podaje aktualną datę. Tak samo jak funkcja DZIŚ() w excelu

Makr w jednym module może być dowolna ilość. Każde rozpoczyna się od słówka SUB i kończy na END SUB. Pomiędzy tymi słowami kluczowymi może być dowolna liczba instrukcji.
JAK URUCHOMIĆ MAKRO?
Mamy na to kilka sposobów:
Bezpośrednio z edytora VBA.
Wystarczy, że klikniesz wewnątrz makra, tak aby wskaźnik tekstu znajdował się wewnątrz makra i naciśniesz zielony trójkąt na pasku narzędzi ( w na górze okna, zaraz pod paskiem tytułu).
Zamiast klikać w trójkąt (Play) możesz również użyć klawisza F5.
Z poziomu Excela.
Jeśli zamkniesz VBA, to w Excelu możesz wywołać okno makr poprzez Developer -> Makra lub kombinację klawiszy Alt + F8.
Po pojawieniu się okna wybieramy interesujące nas makro i klikamy uruchom.

Jest jeszcze klika sposobów uruchamiania makr. Ale o tym przy bardziej zaawansowanych makrach;)

Ćwiczenia ( praca domowa):
1. Napisz makro które wyświetli Twoje imię.
2. Zmodyfikuj poprzednie makro tak, aby za Twoim imieniem pojawiła się aktualna data.
3. Sprawdź co się stanie jak zamiast funkcji DATE użyjesz funkcji TIME lub NOW
4. wypisz imię i datę w 2 oddzielnych msgboxach

POWODZENIA!

Jeśli masz pytania / uwagi / problemy z ćwiczeniami to bardzo proszę o komentarze.

Layout mode
Predefined Skins
Custom Colors
Choose your skin color
Patterns Background
Images Background

Zapisz się na nasz newsletter dotyczący nauki Excela

Wysyłaj mi newsletter (możesz się wypisać w każdym dowolnym momencie).

FreshMail e-mail marketing free online marketing software