A - Vyrobek
B - Datum (setříděný)
C - Požadavek na vyrobu
D - Vyrobene kusy
Makro dopis_vyrobu(vyrobek As String, nove_kusy As Long)
vyrobek := Text ve sloupci A
nove_kusy := počet kusu, které se mají rozdělit.
Makro Test_vyroby()
Vzorove spuštění - musíš ošefovat čtečku a hodnoty podle tohoto vzoru pouštět do makra "dopis_vyrobu"
Stačí takto ?
Option Explicit
'--------------------------------------------------------'
Sub dopis_vyrobu(vyrobek As String, nove_kusy As Long)
'--------------------------------------------------------'
Dim c As Range
Dim s As String
Dim Sl_vyroby As Long
Dim Sl_pozadavek As Long
Dim pozadavek As Long
Dim vyrobeno As Long
Dim rozdil As Long
Sl_vyroby = 3 ' sloupek D
Sl_pozadavek = 2 ' sloupek C
With ActiveSheet
With Range("A1:A" & Range("A65536").End(xlUp).Row)
Set c = .Find(vyrobek, LookIn:=xlValues)
If Not c Is Nothing Then
s = c.Address
Do
vyrobeno = c.Offset(0, Sl_vyroby).Value
pozadavek = c.Offset(0, Sl_pozadavek).Value
' nejdrive otestuji, jestli vyroba odpovida pozadavku
' pokud ANO pak neni nutne pripisovat kusy
If pozadavek > vyrobeno Then
rozdil = pozadavek - vyrobeno
' pokud je kusu mene nebo presne pak ...
If nove_kusy <= rozdil Then
c.Offset(0, Sl_vyroby).Value = vyrobeno + nove_kusy
nove_kusy = 0
Else
' pokud je kusu vice pak ...
c.Offset(0, Sl_vyroby).Value = vyrobeno + rozdil
nove_kusy = nove_kusy - rozdil
End If
End If
Set c = .FindNext(c)
' najdeme dalsi vyskyt vyrobku
Loop While Not c Is Nothing And c.Address <> s And nove_kusy <> 0
Set c = Nothing
End If
End With
End With
End Sub
'--------------------------------------------------------'
Sub Test_vyroby()
'--------------------------------------------------------'
Call dopis_vyrobu("xxx..yyy", 3)
End Sub
'--------------------------------------------------------'
citovat
RSS nejnovější články