Witam,
Proszę o pomoc/poradę przy takim problemie :
Utworzyłem mały skrypt, który ma za zadanie ułatwić mi pracę w arkuszu kalk. Jego działanie polega na tym :
przypisuję do tablica(1) wartość z komórki (124,7), następnie w pętli dla i =1 do 31 dla 31 wierszy wykonuję takie działanie : zaznaczam komórkę (84+i,7) i przypisuję jej wartość do tablicy pakiet, następnie usuwam jej wartość i automatycznie zmienia mi się wartość w komórce (124,7) i tę wartość przypisuję do tablica(i+1) i sprawdzam warunek : jeżeli wartość z tablica(i+1) jest większa od najmniejszej wartość z tej tablicy (utworzyłem funkcję MinTablicy, która ma w każdej kolejnej pętli sprawdzać zawartość tablicy i znajdować jej wartość najmniejszą), wtedy z powrotem przypisuje usuniętą wartość do komórki (84+i,7), która wcześniej została zapamiętana w tablicy pakiet. Jeżeli warunek jest negatywny, usuwa wartość z komórki (84+i,7) i pozostawia komórkę wolną. Problem polega na tym, że w wyniku działania skryptu w poszczególnych wierszach kolumny 7 skrypt nie przypisuje wartości do komórek z warunku if-else.
Function MinTablicy(Tablica As Variant) As Variant
Dim WartMin As Double
Dim IndeksDolny As Long, IndeksGorny As Long, j As Long
IndeksDolny = LBound(Tablica)
IndeksGorny = UBound(Tablica)
WartMin = Tablica(IndeksDolny)
For j = IndeksDolny To IndeksGorny
If Tablica(j) < WartMin Then WartMin = Tablica(j)
Next
MinTablicy = WartMin
End Function
Sub optymalizacja()
Dim i As Integer
Dim Tablica(32) As Variant
Dim pakiet(31) As Variant
Dim min As Double
Erase Tablica
Erase pakiet
Tablica(1) = Cells(124, 7).Value
For i = 1 To 31
pakiet(i) = Cells(84 + i, 7).Value
Cells(84 + i, 7).Select
Selection.ClearContents
Tablica(i + 1) = Cells(124, 7).Value
min = 0
min = MinTablicy(Tablica)
If Tablica(i + 1) > min Then
Cells(84 + i, 7).Value = pakiet(i)
Else
Cells(84 + i, 7).Select
Selection.ClearContents
End If
Cells(128 + i, 7) = Tablica(i)
Cells(128 + i, 8) = min
Next i
End Sub