Nutshell™Nutshell™Nutshell™avatar

Aplikacje biznesowe w MS Office

[ostatnia aktualizacja 2010.12.02 22:52:49 ]

MS OFFICE - Makra i skrypty VISUAL BASIC

  • Marko VBA Excel - 2 ¦REDNIKI 
    ' PRZYKLAD NA KOŁO - 2 ¦REDNIKI
' funkcja obrabia string,
' znajduje w nim 2 liczby
' znajduje w nim srednik,
' zwraca ich iloczyn
' dodatkowo jest podatek

Function rozdzielacz(a As String) As Integer
    Dim d
    d = InStr(a, ";")
    Dim s1, s2, s3, s4

    s1 = Mid(a, 1, d - 1)
    s2 = Mid(a, d + 1, Len(a))

    d = InStr(s2, ";")
    s3 = Mid(s2, 1, d - 1)
    s4 = Mid(s2, d + 1, Len(s2))

    d = (Val(s1) * Val(s3) * (1 + Val(s4) / 100))

    rozdzielacz = d
End Function
  • Marko VBA Excel - 2 ¦REDNIKI ver. 2 
    ' funkcja obrabia string,
' znajduje w nim 2 liczby
' znajduje w nim srednik,
' zwraca ich iloczyn
' dodatkowo jest podatek

Function rozdz(a As String) As Integer
    Dim d
    d = InStr(a, ";")
    Dim s1
    Dim s2
    s1 = Mid(a, 1, d - 1)
    s2 = Mid(a, d + 1, Len(a))
    d = (Val(s1) * Val(s2))
    rozdz = d
End Function

Sub Dodatek()
ActiveCell.Offset(0, 1) = rozdz(ActiveCell.Value)
End Sub
  • Marko VBA Excel - odwracanie kolejnosci znaków w napisie 
    Function rev(a As String) As String
    Dim i, s
    For i = Len(a) To 1 Step -1
        s = s & Mid(a, i, 1)
    Next
    rev = s
End Function

FUNKCJE OPERUJˇCE NA STRINGACH:
=Len(t) - zwraca dlugosc napisu
=Left(t,3) - zwraca 3 pierwsze znaki
=Rigtht (str,3) zwraca 3 ostatnie
=Mid(str, offset, length) - od ktorego znaku do ktorego cos zwraca
=InStr( str, substring) - będzie szukała substring w napisie str ... odo ddaje pierwsze zgodny index
=UCase(string)
=LCase(string)
napisac funkcje ktora zamienia kolejnosc liter w napisie
pętla for

For i = Len(a) To 0 Step -1
(...)
Next

konkatenacja napisow:

t = t & "dodatkowy napis"
kod visual basicco ten kod robi...
Range("E20").Select
ActiveCell.FormulaR1C1 = "dane"		wpisywanie danych do konkretnej komórki
MsgBoxokno informacyjne
InputBoxzczytywanie danych wejściowych
ActiveCellbieżąca komórka
ActiveCell.Value
ActiveCell.Offset(x,y)
Option Explicitmarka wymagają deklarowania zmiennych (używane na samym początku)
dim myvardeklaracja zmiennej
if (IsNumeric(MyVar)=True) then ...
a = InputBox ("podaj coś","Pytanie",30)
a = MessageBox("Wynik",vbOKonly [vbYesNo] [vbCancel])
ActiveCell.Interior.Color = vbBlue
Worksheets(1).Range("a1:b10").Value = "rand()"wypelnianie losowe
if (isNumeric(...) = true) then
if ActiveCell.Value > 0 then
ActiveCell.Offset(0,1).Value="wieksze"
end if		czy komórka jest pusta, czy wartość w niej jest numeryczna
isEmpty()czy komórka jest pusta
select case zmienna
case is < 5
is = 7
case 10 to 20		switch (...)
do while ...
...
loop		pętla while (...) do (...)
do
...
loop while ...		pętla do (...) while (...)
ActiveCell.CurrentRegion.Selectzaznacza przyległe
Selection.Rows.Countliczy wiersze
OptionButton
ComboBox
TextBox
SpinButton
CheckBox
CommandButton
makromakro sprawdzające czy tytuły kolumn są odpowiednio nazwana, dajel input-box'em wpisuje kolejne wiesze (wyszukując pierszy pusty)
Function brutto(a As Integer, b As Integer) As Integer
brutto = a * b
End Function		przykład funkcji, możliwości wywołania:
wstaw|funkcję|uzytkownika - w menu exela
x = brutto(cos,cos); - w markrze sub
MsgBox dodaj(6, 4)wyświetla wynik funkcji dodaj(6,4)
function suma(s1 as integer, s2 as integer, optional s3=0) as integer
suma = s1 + s2 + s3
end function		argument domyślny
funkcji dostępne są tylko te zmienne z zewnątrz które wrzucimy tam poprzez argumenty

Powiedzmy, że mamy do czynienia z logami: 1 kolumna - data, 2 - ga czas, 3 - cia IP, 4 - domena, 5 - adres przychodzący, 6 - przeglądarka

  • Marko VBA Excel - Usuwanie duplikatów 
    ' Usuwanie duplikatów
' takich samych wierszy następujących po sobie
' każdorazowo usuwany jest pierwszy z tych dwóch
Sub usunTakieSameWiersze()
    Dim ilewierszy
    ilewierszy = 0
    Dim info As Boolean
    info = False
    Range("A1").Activate
    
    Do While (ActiveCell.Value <> "")
        If (ActiveCell.Offset(0, 2).Value = _
            ActiveCell.Offset(1, 2).Value) Then
        
        If (ActiveCell.Offset(0, 3).Value = _
            ActiveCell.Offset(1, 3).Value) Then
        
        If (ActiveCell.Offset(0, 4).Value = _
            ActiveCell.Offset(1, 4).Value) Then
        
        If (ActiveCell.Offset(0, 6).Value = _
            ActiveCell.Offset(1, 6).Value) Then
            
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(-1, 0).Activate
            ilewierszy = ilewierszy + 1
            
        End If
        End If
        End If
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
    If (info = True) Then
        MsgBox ("Skasowano " + Str(ilewierszy) + _
        " wierszy")
    End If
End Sub
  • Marko VBA Excel - Zamiana adresu http na link 
    Sub adresRefNaLink()
    Dim ilewierszy
    ilewierszy = 0
    Range("f1").Activate
    
    Do While (ActiveCell.Offset(0, -5).Value <> "")
    If (InStr(LCase(ActiveCell.Value), "http://") = 1) Then
        If (InStr(ActiveCell.Value, " ") < 1) Then
            ActiveSheet.Hyperlinks.Add _
                Anchor:=Selection, _
                Address:=ActiveCell.Value, _
                TextToDisplay:=ActiveCell.Value
            ilewierszy = ilewierszy + 1
        End If
    End If
    ActiveCell.Offset(1, 0).Activate
    Loop
    
    MsgBox ("Przerobiono " + Str(ilewierszy) + " wierszy")
End Sub
  • Marko VBA Excel - Logi - skracanie nazw przeglądarek 
    Sub przegladarka()
    Range("a1").Activate
    Do While (ActiveCell.Value <> 0)
        If (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "firefox") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Fx"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "opera") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Opera"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "avant browser") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Avant"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "msie") > 0) Then
            ActiveCell.Offset(0, 6).Value = "IE"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "googlebot") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Gbot"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "yahoo! slurp") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Yahoo"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "w3c_validator") > 0) Then
            ActiveCell.Offset(0, 6).Value = "W3C"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "onetszukaj") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Onet"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "msnbot") > 0) Then
            ActiveCell.Offset(0, 6).Value = "MSN"
        ElseIf (InStr(LCase(ActiveCell.Offset(0, 6).Value), _
            "mozilla") > 0) Then
            ActiveCell.Offset(0, 6).Value = "Mozilla"
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
End Sub