Excel Kraszewski

Dotychczasowy założyciel grupy Excel Kraszewski nie pełni już swojej funkcji. Jeśli w ciągu 7 dni nie zostanie wybrany nowy, grupa zostanie skasowana. Chętnych do objęcia wolnego stanowiska proszę o wpisanie komentarza do tej wypowiedzi. Zgłoszenia przesyłane przy pomocy wiadomości prywatnych nie będą rozpatrywane.

Trochę mnie poniosło z zakładaniem bloga w okresie kumulacji obowiązków zawodowych i tych poza zawodowych również.
Punkt kulminacyjny jest teraz, więc mam nadzieję, że niedługo wznowię działalność!

Kolejne makro które na stałe mam przypięte do paska szybkiego dostępu tworzy zakresy dynamiczne.

Zakresy dynamiczne przydają się np przy tworzeniu słowników wykorzystywanych później do tworzenia list rozwijanych z użyciem sprawdzania poprawności. Wraz z rozbudową słownika dodane wpisy z automatu będą dostępne na liście rozwijanej.
Oczywiście można również na sztywno zdefiniować obszar z zapasem, ale wtedy będziemy mieli puste pola na liście co jest po pierwsze nieestetyczne po wtóre może być nieporządane jeśli wybór wartości z listy rozwijanej rzutuje na działanie arkusza.

Zakres dynamiczny można stworzyć ręcznie, wystarczy zdefiniowanej nazwie określić zakres do którego się odwołuje za pomoca formuły, np:

=PRZESUNIĘCIE(Arkusz1!$H$4:$H$17;0;0;ILE.NIEPUSTYCH(Arkusz1!$H$4:$H$17);)

Ale to chwile zajmuje więc wole używać makra. Kod poniżej:


Public Sub ZakresDynamiczny()
Dim dynRangeName As String
Dim rNam As Name

'Sprawdzam, czy obiekt selection jest zakresem
If TypeName(Selection) <> "Range" Then
Call MsgBox("Zaznacz zakres komórek, dla którego ma być utworzony zakres dynamiczny", vbInformation, "Błędne zaznaczenie")
GoTo sprzątam
End If
'wprowadzam nazwę dla zakresu
dynRangeName = InputBox("Wprowadź nazwę zakresu dynamicznego", "Podaj nazwę")
' Sprawdzam, czy wprowadzono tekst w inputboxie
If dynRangeName = vbNullString Then
Call MsgBox("Nie podano nazwy zakresu!", vbCritical)
GoTo sprzątam
End If
'sprawdzam, czy nazwa nie jest już używana w arkuszu
For Each rNam In ActiveWorkbook.Names
If rNam.Name = dynRangeName Then
MsgBox ("Podana nazwa jest już używana, spróbuj ponownie i podaj inną nazwę")
GoTo sprzątam
End If
Next
'Dodaję nazwę
ActiveWorkbook.Names.Add Name:=dynRangeName, RefersToR1C1:= _
"=OFFSET(" & Selection.Parent.Name & "!R" & Selection.Row & "C" & Selection.Column & _
":R" & Selection.Rows.Count + Selection.Row - 1 & "C" & Selection.Columns.Count + Selection.Column - 1 & _
",0,0,COUNTA(" & Selection.Parent.Name & "!R" & Selection.Row & "C" & Selection.Column & ":R" & _
Selection.Row + Selection.Rows.Count - 1 & "C" & Selection.Column & "),)"
'ActiveWorkbook.Names("test").Comment = ""
sprzątam:
Set rNam = Nothing
End Sub

Na dobry początek mam makro wstawiające okresy.
Jeżeli zdarza się Wam przedstawiać np. dynamikę wskaźników lub jakiekolwiek dane w ujęciu miesięcznym, to z pewnością często wykorzystujecie takie nagłówki: 2012-1|2012-2|etc.
Ja wykorzystuję to makro bardzo często.
Takie nagłówki to świetny sposób na późniejszą agregację danych z zewnętrznych źródeł, np tabeli. Może on być np argumentem funkcji Suma.Warunków

Makro pozwala nam wybrać kierunek wypełniania (pion/poziom), zakres czasowy i rodzaj znaku rozdzielającego. Nie posiada rozbudowanej obsługi błędów więc jeśli poda się niepoprawne wartości po prostu pokaże komunikat błędu i zakończy działanie.

Kod:

Sub WstawOkresy()
Dim iMs As Integer 'miesiac początkowy
Dim iYs As Long 'rok początkowy
Dim iONo As Integer ' liczba okresów
Dim Vert As Integer ' Orientacja pozioma/pionowa
Dim r As Integer, c As Integer 'zmienne definiujace offset dla wierszy i kolumn
Dim sDelimit As String 'znak rozdielający rok i miesiąc
Dim calcSetting As Long

On Error GoTo out:
'zapisuję ustawienia obliczania, aktywuję tryb manualny
calcSetting = Application.Calculation
Application.Calculation = xlManual

iMs = CInt(InputBox("Podaj pierwszy miesiąc okresu"))
iYs = CInt(InputBox("Podaj pierwszy rok okresu"))
iONo = CInt(InputBox("Podaj liczbe okresów"))
Vert = MsgBox("Czy okresy mają być poziomo?", vbYesNo)
sDelimit = InputBox("Wprowadź znak rozdzielający rrrr i mm", , "-")

Select Case Vert
Case 7
r = 1
c = 0
Case 6
r = 0
c = 1
End Select

Do While iONo > 0
ActiveCell.Formula = iYs & sDelimit & iMs
iONo = iONo - 1
If iMs = 12 Then
iMs = 1
iYs = iYs + 1
Else
iMs = iMs + 1
End If
ActiveCell.Offset(r, c).Select
Loop
sprzatam:
Application.Calculation = calcSetting
Exit Sub
out:
MsgBox (Err.Number)
GoTo sprzatam
End Sub

Dzięki, mam nadzieje, że uda mi się wrzucić coś przydatnego.
Oczywiście pomijam Darka, bo jego obecność jest tu czysto grzecznościowa :)

Witam i życzę powodzenia :)

Niezły pomysł. Mam nadzieję, że grupa się rozkręci. :)

Właśnie jestem w trakcie przenoszenia danych na nowy komputer.
A więc na świeżo, jak przenieść w Excelu 2007 swój zmodyfikowany pasek szybkiego dostępu?
Ja mam sporo swoich skrótów, makr etc więc zależało mi na bezboleśnym transferze.

W Excelu 2010 sprawa jest prostsza: Plik=>Opcje programu Excel=>Dostosowanie i tam są opcje importu/exportu.

W Excelu 2007 natomiast należy otworzyć katalog:

C:Usersnazwa użytkownikaAppDataLocalMicrosoftOffice

I skopiować plik Excel.Que do analogicznego folderu na drugim komputerze