'********************************************************************************************************** ' Nazwa: ostatniNiepustyWiersz ' Autor: mielk | 2012-04-05 ' ' Opis: Funkcja zwraca numer ostatniego niepustego wiersza w podanym arkuszu Excela. Za ' niepusty wiersz uznawany jest każdy wiersz, w którym w co najmniej jednej komórce ' znajduje się wartość lub funkcja (nawet jeżeli funkcja ta zwraca w wyniku pusty ' ciąg znaków). ' ' Argumenty: ' arkusz Arkusz Excela, dla którego ma zostać wyznaczony numer ostatniego niepustego ' wiersza. ' wierszStartowy Opcjonalny parametr typu Long. ' * Pozwala ograniczyć od góry przeszukiwany zakres. Jeżeli ten argument został ' podany, makro rozpoczyna przeszukiwanie arkusza od podanego wiersza zamiast od ' początku arkusza i zignoruje wszystkie wiersze powyżej tego wiersza. ' * Jeżeli ten argument jest równy lub mniejszy od 0, makro działa tak jakby w ogóle ' nie był podany i rozpoczyna szukanie od pierwszego wiersza w arkuszu. ' kolumnaStartowa Opcjonalny parametr typu Long. ' * Pozwala ograniczyć z lewej strony przeszukiwany zakres. Jeżeli ten argument ' został podany przeszukiwanie arkusza rozpoczyna się od kolumny z takim ' indeksem. ' * Jeżeli ten argument jest równy lub mniejszy od 0, makro działa tak jakby w ogóle ' nie był podany i rozpoczyna szukanie od pierwszej kolumny w arkuszu. ' wierszKoncowy Opcjonalny parametr typu Long. ' * Pozwala ograniczyć od dołu przeszukiwany zakres. Jeżeli ten argument został ' podany, makro kończy przeszukiwanie arkusza na podanym wierszu ' * Jeżeli ten argument jest równy lub mniejszy od 0, makro działa tak jakby w ogóle ' nie był podany i kończy szukanie na ostatnim wierszu w arkuszu. ' kolumnaKoncowa Opcjonalny parametr typu Long. ' * Pozwala ograniczyć od prawej przeszukiwany zakres. Jeżeli ten argument został ' podany, makro kończy przeszukiwanie na kolumnie z takim indeksie a nie na końcu ' pliku. ' * Jeżeli ten argument jest równy lub mniejszt od 0, makro działa tak, jakby w ogóle ' nie był podany i kończy szukanie na ostatniej kolumnie arkusza. ' ignorujUkryteKomorki ' Opcjonalny parametr typu Boolean. ' * Informuje czy funkcja powinna ignorować ukryte komórki podczas przeszukiwania ' arkusza. ' * Domyślna wartość tego parametru to False. Jeżeli jest on pominięty podczas ' wywoływania funkcji, ukryte komórki będą przeszukiwane tak samo jak widoczne. ' ' ' Zwraca: ' Long Indeks ostatniego niepustego wiersza w podanym arkuszu Excela. ' Jeżeli żaden niepusty wiersz nie zostanie znaleziony, zwracane jest 0. ' ' ' Wyjątki: ' NieprawidłowyArkusz Wywoływany, kiedy arkusz Excela przekazany do tej funkcji w parametrze ' [arkusz] znajduje się w pliku, który został już zamknięty. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-04-05 mielk Utworzenie funkcji. ' 2013-04-19 mielk Dodane argumenty opcjonalne umożliwiające ograniczenie przeszukiwanego ' zakresu kolumn. ' 2013-04-23 mielk Dodane argumenty opcjonalne umożliwiające ograniczenie przeszukiwanego ' zakresu wierszy. '********************************************************************************************************** Public Function ostatniNiepustyWiersz(arkusz As Excel.Worksheet, _ Optional wierszStartowy As Long, Optional kolumnaStartowa As Long, _ Optional wierszKoncowy As Long, Optional kolumnaKoncowa As Long, _ Optional ignorujUkryteKomorki As Boolean = False) As Long Const NAZWA_METODY As String = "ostatniNiepustyWiersz" '------------------------------------------------------------------------------------------------------ Dim lngRow As Long Dim lngWierszStart As Long Dim lngWierszKoniec As Long Dim lngNiepuste As Long Dim lngKolumnaStart As Long Dim lngKolumnaKoniec As Long Dim zakres As Excel.Range '------------------------------------------------------------------------------------------------------ 'Sprawdź, czy arkusz, w którym będziemy szukać pierwszej niepustej kolumny, jest poprawny -----------| 'i można odwoływać się do jego właściwości. Jeżeli arkusz nie jest poprawny, kod przeskakuje '| 'do labelu NieprawidlowyArkusz i kończy działanie fukcji. '| If Not czyPrawidlowyArkusz(arkusz) Then GoTo NieprawidlowyArkusz '| '----------------------------------------------------------------------------------------------------| 'Wyznacz właściwy zakres do przeszukania uwzględniając opcjonalne parametry podane podczas ----------| 'wywoływania funkcji. '| If kolumnaStartowa > 0 And kolumnaStartowa <= arkusz.columns.Count Then _ lngKolumnaStart = kolumnaStartowa Else lngKolumnaStart = 1 '| If kolumnaKoncowa > 0 And kolumnaKoncowa <= arkusz.columns.Count Then _ lngKolumnaKoniec = kolumnaKoncowa Else lngKolumnaKoniec = arkusz.columns.Count '| If wierszStartowy > 0 And wierszStartowy <= arkusz.rows.Count Then _ lngWierszStart = wierszStartowy Else lngWierszStart = 1 '| If wierszKoncowy > 0 And wierszKoncowy <= arkusz.rows.Count Then _ lngWierszKoniec = wierszKoncowy Else lngWierszKoniec = arkusz.rows.Count '| '----------------------------------------------------------------------------------------------------| Ponow: lngRow = 1 '----------------------------------------------------------------------------------------------------| Do '| Set zakres = arkusz.Range(arkusz.Cells(lngRow, lngKolumnaStart), _ arkusz.Cells(lngWierszKoniec, lngKolumnaKoniec)) '| lngNiepuste = Excel.Application.WorksheetFunction.CountA(zakres) '| '| '--------------------------------------------------------------------------------------------| '| If lngNiepuste Then '| '| If lngRow = lngWierszKoniec Then Exit Do '| '| lngWierszStart = lngRow '| '| lngRow = lngRow + ((lngWierszKoniec - lngRow + 1) / 2) '| '| Else '| '| lngWierszKoniec = lngRow - 1 '| '| lngRow = lngWierszStart '| '| '| '| '------------------------------------------------------------------------------------| '| '| If lngWierszStart > lngWierszKoniec Then '| '| '| lngRow = 0 '| '| '| Exit Do '| '| '| End If '| '| '| '---------- [If lngWierszStart > lngWierszKoniec Then] ------------------------------| '| '| '| '| End If '| '| '-------------- [If lngNiepuste Then] -------------------------------------------------------| '| '| Loop '| '----------------------------------------------------------------------------------------------------| '----------------------------------------------------------------------------------------------------| If lngRow Then '| '| '--------------------------------------------------------------------------------------------| '| If ignorujUkryteKomorki And arkusz.rows(lngRow).Hidden Then '| '| lngWierszKoniec = nastepnyWidocznyWiersz(arkusz, lngRow, Excel.xlUp) '| '| If lngWierszKoniec Then GoTo Ponow '| '| Else '| '| ostatniNiepustyWiersz = lngRow '| '| End If '| '| '-------------- [If ignorujUkryteKomorki And arkusz.rows(lngRow).Hidden Then] ---------------| '| '| End If '| '------------------ [If lngRow Then] ----------------------------------------------------------------| '========================================================================================================== PunktWyjscia: Exit Function '---------------------------------------------------------------------------------------------------------- NieprawidlowyArkusz: 'Obsługa błędów dla sytuacji, kiedy podany arkusz jest nieprawidłowy i nie można odnieść się do jego 'właściwości (np. plik, w którym znajduje się ten arkusz, został zamknięty). GoTo PunktWyjscia End Function '********************************************************************************************************** ' Nazwa: czyPrawidlowyArkusz ' Autor: mielk | 2012-11-16 ' ' Opis: Funkcja sprawdzająca czy podany arkusz Excela jest prawidłowy i można odwoływać się ' do jego właściwości i metod bez obawy, że zostanie wygenerowany błąd. ' ' Funkcja jest bardzo pomocna, ponieważ pozwala uniknąć błędu ' Run-time error '-2147221080 (800401a8)': Automation error. ' Błąd ten jest generowany w sytuacji, kiedy kod próbuje się odnieść do właściwości ' lub metody zmiennej arkuszowej, ale arkusz, do którego odnosi się ta zmienna, ' został wcześniej usunięty lub plik, w którym ten arkusz się znajduje został ' zamknięty. ' ' Argumenty: ' arkusz Sprawdzany arkusz. ' ' Zwraca: ' Boolean True - jeżeli sprawdzany arkusz jest prawidłowy i bez obaw można się odnosić do ' jego właściwości i metod. ' False - jeżeli podany arkusz jest nieprawidłowy (zazwyczaj przyczyną jest fakt, ' że plik Excela, w którym znajduje się ten arkusz został wcześniej zamknięty ' lub arkusz został usunięty). ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-11-16 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function czyPrawidlowyArkusz(arkusz As Excel.Worksheet) As Boolean Const NAZWA_METODY As String = "czyPrawidlowyArkusz" '------------------------------------------------------------------------------------------------------ Dim strNazwaArkusza As String '------------------------------------------------------------------------------------------------------ On Error Resume Next strNazwaArkusza = arkusz.name 'Jeżeli nazwa podanego arkusza została przypisana do zmiennej [strNazwaArkusza], oznacza to, że arkusz 'jest prawidłowy i można odwoływać się do jego właściwości bez obawy o pojawienie się błędów. czyPrawidlowyArkusz = VBA.Len(strNazwaArkusza) End Function '********************************************************************************************************** ' Nazwa: nastepnyWidocznyWiersz ' Autor: mielk | 2013-03-24 ' ' Opis: Funkcja zwracająca numer następnego widocznego wiersza w górę lub w dół od podanego ' wiersza w określonym arkuszu Excela ' ' Argumenty: ' arkusz Arkusz, na którym przeprowadzone będzie szukanie następnego widocznego wiersza. ' poczatkowyWiersz Początkowy wiersz, z którego rozpoczyna się szukanie następnego widocznego wiersza. ' kierunek Kierunek poszukiwania następnego widocznego wiersza. ' * Jedyne dostępny wartości dla tego parametru to xlUp i xlDown. ' * Teoretycznie do funkcji można też podać inne kierunki zdefiniowane w enumeracji ' xlDirection (xlToLeft i xlToRight), ale funkcja zwróci w takim przypadku 0, ' ponieważ wiersze nie mogą być przeszukiwane horyzontalnie. ' ' Zwraca: ' Long Numer indeksu następnego widocznego wiersza w stronę określoną przez parametr ' [kierunek], począwszy od podanego wiersza w określonym arkuszu. ' ' Funkcja zwraca 0, jeżeli powyżej (lub poniżej, w zależności od wartości parametru ' [kierunek]) od podanego wiersza nie ma żadnego widocznego wiersza. ' ' Żeby uzyskać numer indeksu następnego widocznego wiersza w całym arkuszu Excela, ' wystarczy wywołać tę funkcję z następującymi argumentami wejściowymi: ' poczatkowyWiersz = 0 oraz kierunek = xlDown. ' ' ' Wyjątki: ' NieprawidłowyArkusz Wywoływany, kiedy arkusz Excela przekazany do tej funkcji w parametrze ' [arkusz] znajduje się w pliku, który został już zamknięty. ' ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-04-05 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function nastepnyWidocznyWiersz(arkusz As Excel.Worksheet, poczatkowyWiersz As Long, _ kierunek As XlDirection) As Long Const NAZWA_METODY As String = "nastepnyWidocznyWiersz" '------------------------------------------------------------------------------------------------------ Dim intPrzesuniecie As Integer '------------------------------------------------------------------------------------------------------ 'Sprawdź, czy arkusz, w którym będziemy szukać pierwszej niepustej kolumny, jest poprawny -----------| 'i można odwoływać się do jego właściwości. Jeżeli arkusz nie jest poprawny, kod przeskakuje '| 'do labelu NieprawidlowyArkusz i kończy działanie fukcji. '| If Not czyPrawidlowyArkusz(arkusz) Then GoTo NieprawidlowyArkusz '| '----------------------------------------------------------------------------------------------------| '----------------------------------------------------------------------------------------------------| Select Case kierunek '| Case Excel.xlUp: intPrzesuniecie = -1 '| Case Excel.xlDown: intPrzesuniecie = 1 '| Case Else '| nastepnyWidocznyWiersz = poczatkowyWiersz '| GoTo PunktWyjscia '| End Select '| '----------------------------------------------------------------------------------------------------| 'Przechodź po kolei przez wszystkie wiersze w dół lub w górę od wskazanego wiersza (w zależności ----| 'od wartości parametru [kierunek] i sprawdzaj czy są one widoczne. '| nastepnyWidocznyWiersz = poczatkowyWiersz '| Do '| nastepnyWidocznyWiersz = nastepnyWidocznyWiersz + intPrzesuniecie '| If Not arkusz.rows(nastepnyWidocznyWiersz).Hidden Then Exit Do '| Loop '| '----------------------------------------------------------------------------------------------------| '========================================================================================================== PunktWyjscia: Exit Function '---------------------------------------------------------------------------------------------------------- NieprawidlowyArkusz: 'Obsługa błędów dla sytuacji, kiedy podany arkusz jest nieprawidłowy i nie można odnieść się do jego 'właściwości (np. plik, w którym znajduje się ten arkusz, został zamknięty). GoTo PunktWyjscia End Function