VBA - optymalizacja :: 4programmers.net

0

Hejo!
Jestem początkującym koderem VBA. Zrobiłem excelowski plik do prowadzenia magazynu w firmie w której pracuję. Całość opera się na UserForm'ach.
Sęk w tym, że na moim komputerze dodawanie pozycji na magazyn trwa 0,27 sek - więc nie ma co narzekać. Ale jeżeli chodzi o komputer w pracy to jest to już 4 razy dłużej (ponad sekundę) więc robi się to uciążliwe.

Textboxy: kod, regal, lotto, uwagi, naregale, ilosc, osoba

Bardzo proszę o wskazówki:

Public klik As Boolean
Public Cell As Range
Public wiersz As Integer, ile As Integer, ile2 As Integer, ile3 As Integer
Private Sub UserForm_Initialize()
Dim cll As Range
For Each rng In Array(Range("Kody"), Range("KODYNTK"))
    For Each cll In rng
        kod.AddItem cll.Value
    Next cll
Next rng
End Sub
Private Sub kod_Change()
Set wK = Worksheets("KODY")
Set wM = Worksheets("MAG")
On Error Resume Next
kodk.Value = ""
naregale = ""
lotto = ""
regal = ""
ilosc = ""
naregale.Visible = False
kodk.Value = Application.WorksheetFunction.VLookup(kod, wK.Range("A:C"), 2, False)
ile = wM.Cells(Rows.Count, 1).End(xlUp).row
'szukanie ilosci
For Each Cell In Range("A5:D" & ile)
    If Cell.Value = kod Then
        wiersz = Cell.row
        If Cells(wiersz, 3).Value = regal Then
            If Cells(wiersz, 5).Value = lotto Then
                naregale.Visible = True
                naregale = Cells(wiersz, 4).Value
            End If
        End If
    End If
Next Cell

ile3 = Application.WorksheetFunction.CountIf(Range("A:A"), kod)
If ile3 = 0 Or kod = "" Then ile3 = 1
ReDim Palety(ile3 - 1, 2) As String

ile2 = Cells(Rows.Count, 1).End(xlUp).row
For Each Cell In Range("A5:A" & ile2 + 1)
    If Cell.Value = kod Then
            Palety(i, 0) = wM.Cells(Cell.row, 5) 'lotto
            Palety(i, 1) = wM.Cells(Cell.row, 3) 'regal
            Palety(i, 2) = wM.Cells(Cell.row, 4) 'ilosc
            i = i + 1
            If i = ile3 Then
                GoTo koniec
            End If
    End If
Next Cell
koniec:
ListBox1.List = Palety

End Sub
Private Sub ListBox1_Click()
Dim reg As String, lot As String
Dim SelectedItems As String
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        reg = ListBox1.List(i, 1)
        lot = ListBox1.List(i, 0)
    End If
Next i
klik = True
regal = reg
lotto = lot
End Sub
Private Sub regal_Change()
Set wK = Worksheets("KODY")
Set wM = Worksheets("MAG")

naregale = ""
regal.BackColor = RGB(255, 255, 255)
If klik = True Then regal.BackColor = RGB(204, 255, 204)
naregale.Visible = False
ile = wM.Cells(Rows.Count, 1).End(xlUp).row
'szukanie ilosci
For Each Cell In Range("C5:C" & ile)
    If Cell.Value = regal Then
        wiersz = Cell.row
        If Cells(wiersz, 1).Value = kod Then
            If Cells(wiersz, 5).Value = lotto Then
                naregale.Visible = True
                naregale = Cells(wiersz, 4).Value
            End If
        End If
    End If
Next Cell
'klik = False
End Sub
Private Sub lotto_Change()

Set wK = Worksheets("KODY")
Set wM = Worksheets("MAG")
naregale = ""
lotto.BackColor = RGB(255, 255, 255)
If klik = True Then lotto.BackColor = RGB(204, 255, 204)
naregale.Visible = False
ile = wM.Cells(Rows.Count, 1).End(xlUp).row
'szukanie ilosci
For Each Cell In Range("E5:E" & ile)
    If Cell.Value = lotto Then
        wiersz = Cell.row
        kolumna = Cell.Column
        If Cells(wiersz, kolumna - 4).Value = kod Then
            If Cells(wiersz, kolumna - 2).Value = regal Then
                naregale.Visible = True
                naregale = Cells(wiersz, 4).Value
            End If
        End If
    End If
Next Cell
klik = False
End Sub
Private Sub Mag_dodaj_Click()
Dim nrmod As Integer, bylo As Long, jest As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
Set wa = ActiveSheet
Set wH = Worksheets("HISTORY")
Set wM = Worksheets("MAG")

'StartTime = Timer

ile = wM.Cells(Rows.Count, 1).End(xlUp).row
'sprawdzamy kod
If kod = 0 Or kod = "" Or kod = " " Or kod = "  " Then
    result = MsgBox("Podaj kod!", vbCritical, "Ten regał jest pusty!")
    Exit Sub
End If
If InStr(kod, " ") Then
    result = MsgBox("Kod zawiera spacje!", vbCritical, "Błąd!")
    Exit Sub
End If
'sprawdzamy lotto
If lotto = 0 Or lotto = "" Or lotto = " " Or lotto = "  " Then
    result = MsgBox("Podaj lotto!", vbCritical, "Błąd!")
    Exit Sub
End If
If InStr(lotto, " ") Then
    result = MsgBox("Lotto zawiera spacje!", vbCritical, "Błąd!")
    Exit Sub
End If
'sprawdzamy regal
If regal = "" Or regal = " " Or regal = "  " Then
    result = MsgBox("Podaj regał!", vbCritical, "Błąd!")
    Exit Sub
End If
If InStr(regal, " ") Then
    result = MsgBox("Regal zawiera spacje!", vbCritical, "Błąd!")
    Exit Sub
End If
'sprawdzamy ilosc
If Not IsNumeric(ilosc) Then
    result = MsgBox("Ilość jest niepoprawna!", vbCritical, "Błąd!")
    Exit Sub
End If
If ilosc <= 0 Then
    result = MsgBox("Podaj wartość dodatnią", vbCritical, "Błąd!")
    Exit Sub
End If
If ilosc = "" Or ilosc = " " Then
    result = MsgBox("Podaj ilość!", vbCritical, "Błąd!")
    Exit Sub
End If
If InStr(ilosc, " ") Then
    result = MsgBox("Ilość zawiera spacje!", vbCritical, "Błąd!")
    Exit Sub
End If
'sprawdzamy osobe
If osoba = "" Or osoba = " " Or osoba = "  " Then
    result = MsgBox("Podaj imię!", vbCritical, "Błąd!")
    Exit Sub
End If
unprot
ResetFilters

If naregale = "" Then
    wierszM = wM.Cells(Rows.Count, 1).End(xlUp).row + 1
    akcja = "Dodano na magazyn"
    wM.Cells(wierszM, 1) = kod
    wM.Cells(wierszM - 1, 2).Copy
    wM.Cells(wierszM, 2).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    wM.Cells(wierszM, 3) = regal
    wM.Cells(wierszM, 4) = CLng(Me.ilosc)
    wM.Cells(wierszM, 5) = lotto
    wM.Cells(wierszM, 6) = uwagi
    wM.Cells(wierszM, 7) = Date
    wM.Cells(wierszM, 8) = osoba
    bylo = 0
    jest = ilosc
    nrmod = 0
Else
For Each Cell In Range("A6:A" & ile)
    If Cell.Value = kod Then
        wiersz = Cell.row
        If Cells(wiersz, 3).Value = regal Then
            If Cells(wiersz, 5).Value = lotto Then
                akcja = "Zwiększono stan"
                bylo = wM.Cells(wiersz, 4)
                nrmod = wM.Cells(wiersz, 11) + 1
                naregale.Visible = True
                nowailosc = CLng(Me.ilosc) + CLng(Me.naregale)
                naregale = nowailosc
                wM.Cells(wiersz, 4) = nowailosc
                jest = nowailosc
                wM.Cells(wiersz, 9) = Date
                wM.Cells(wiersz, 10) = osoba
                wM.Cells(wiersz, 11) = wM.Cells(wiersz, 11).Value + 1
                GoTo jump
            End If
        End If
    End If
Next Cell
End If
jump:
wiersz = wH.Cells(Rows.Count, 1).End(xlUp).row + 1
wH.Cells(wiersz, 1) = Date
wH.Cells(wiersz, 2) = akcja
wH.Cells(wiersz, 3) = kod
wH.Cells(wiersz, 5) = regal
wH.Cells(wiersz, 6) = bylo
wH.Cells(wiersz, 7) = jest
wH.Cells(wiersz, 8) = "'+" & ilosc
wH.Cells(wiersz, 9) = lotto
wH.Cells(wiersz, 10) = uwagi
wH.Cells(wiersz, 11) = osoba
wH.Cells(wiersz, 12) = nrmod 'numer modyfikacji
prot
lol = kod
kod = ""
kod = lol

  'SecondsElapsed = Round(Timer - StartTime, 2)
  'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
  
MsgBox ("Dodano " & kod & " na magazyn")
ActiveWorkbook.Save
End Sub
Private Sub prot()
    On Error Resume Next
    Worksheets("MAG").protect Password:="lol", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True, AllowUsingPivotTables:= _
        True
    Worksheets("HISTORY").protect Password:="lol", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True, AllowUsingPivotTables:= _
        True
End Sub
Private Sub unprot()
    On Error Resume Next
    Worksheets("HISTORY").Unprotect Password:="lol"
        Worksheets("MAG").Unprotect Password:="lol"
End Sub

title

0

Serio sądzisz, że komuś będzie się chciało analizować 257 linii kodu? Tym bardziej, że nie wiadomo, co jest w danych i jaki to ma wpływa na działanie kodu...

0

Marcin.Miga napisał(a):

Serio sądzisz, że komuś będzie się chciało analizować 257 linii kodu? Tym bardziej, że nie wiadomo, co jest w danych i jaki to ma wpływa na działanie kodu...

Nie, liczę tylko na wskazówki.
Dane kodu to w większości string,

0

Prawie wszystko masz w jednej funkcji? Wow.
Wypadałoby załączyć szablon, na którym można to sobie puścić. Nie chce mi się tworzyć takiego od zera i w sumie to nie mam czasu na analizę kodu, który prawie wszystko robi w jednej funkcji. Mogę więc jedynie podpowiedzieć, że możesz poszukać sobie w internecie "profiler + vba", użyć np. tego narzędzia: https://sysmod.wordpress.com/2017/03/09/free-add-in-to-profile-vba-speed-and-coverage/ i wyłapać miejsca, gdzie kod spowalnia (ale to raczej ci słabo zadziała, skoro nie wydzieliłeś żadnych funkcji...). Jak nie umiesz użyć profilera, to możesz ten czas mierzyć funkcjami do mierzenia czasu: https://www.thespreadsheetguru.com/the-code-vault/2015/1/28/vba-calculate-macro-run-time
Możesz też spokojnie założyć, że spowalnia ci przez ilość pętli w kodzie. Zastanów się, czy naprawdę musisz robić for each po kilka razy? Nie da się tego w jednym obiegu? Na to pytanie nie odpowiem, bo musiałabym najpierw zrozumieć, co się w kodzie dzieje, a na to nie mam czasu.

VBA - optymalizacja

Marcin.Miga napisał(a):

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami