AW: VBA Dauer berechnen
18.09.2017 14:57:14
Peter(silie)
Hallo,
weitere eingaben als die kmh musst du noch hinzufügen.
hier Mappe: https://www.herber.de/bbs/user/116332.xlsm
Hier der Code:
Option Explicit
Private articel_ As Worksheet
Private distance_ As Worksheet
Private order_ As Worksheet
Public Sub GetDurations()
Dim IDs_(), region_() As Variant
Dim definedDistance As Long
Dim speedInput As Long
Dim lRow, i As Long
Dim time_ As Double
speedInput = Application.InputBox("Gabelstapler geschwindigkeit in kmh:", Type:=1)
Set articel_ = ThisWorkbook.Sheets("Artikel")
Set distance_ = ThisWorkbook.Sheets("Entfernungen")
Set order_ = ThisWorkbook.Sheets("Auftrag")
lRow = LastRow(order_, 1)
With order_
For i = 2 To lRow
IDs_ = GetArticels(i)
region_ = DefineRegion(IDs_)
definedDistance = DefineDistance(region_)
time_ = EvaluateTime(definedDistance, speedInput)
.Cells(i, 7).Value = time_
Next i
End With
End Sub
'//Get last cell of given sheet and column
Private Function LastRow(ByVal refSheet As Worksheet, ByVal column_ As Long) As Long
With refSheet
LastRow = .Cells(.Rows.Count, column_).End(xlUp).Row
End With
End Function
'//Get Articels of Row
Private Function GetArticels(ByVal row_ As Long) As Variant
Dim array_() As Variant
Dim i, counter As Long
With order_
For i = 2 To 6
If .Cells(row_, i).Value "" Then
ReDim Preserve array_(counter)
array_(counter) = .Cells(row_, i).Value
counter = counter + 1
End If
Next i
End With
GetArticels = array_
End Function
'//Get the Komm-Ber. of the Articels
Private Function DefineRegion(ByRef ID_ As Variant) As Variant
Dim counter, iter As Long
Dim array_() As Variant
Dim rng, c As Range
Dim lRow As Long
ReDim array_(UBound(ID_))
lRow = LastRow(articel_, 1)
With articel_
Set rng = .Range(.Cells(1, 1), .Cells(lRow, 1))
For iter = 0 To UBound(ID_)
Set c = rng.Find(ID_(iter), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then array_(iter) = c.Offset(, 1).Value
Next iter
End With
DefineRegion = array_
End Function
'//Distance in m
Private Function DefineDistance(ByRef region_ As Variant) As Long
Dim rng_1, rng_2, c As Range
Dim parentNode_ As Variant
Dim nodeRow As Long
Dim iter As Long
Dim tmp As Long
parentNode_ = region_(0)
With distance_
Set rng_1 = .Range(.Cells(1, 1), .Cells(8, 1))
Set rng_2 = .Range(.Cells(1, 1), .Cells(1, 8))
Set c = rng_1.Find(parentNode_, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then tmp = tmp + c.Offset(, 1).Value: nodeRow = c.Row
For iter = 1 To UBound(region_)
Set c = rng_2.Find(region_(iter), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then tmp = tmp + .Cells(nodeRow, c.Column).Value
Next iter
End With
DefineDistance = tmp
End Function
Private Function EvaluateTime(ByVal meters_ As Long, ByVal speed_ As Long) As Double
'//speed in km/h
'//meters in meter
'//meter per minute
speed_ = speed_ * 16.6667
'//Time = 1m * time
'//Example: (300m / (10kmh * 16.6667)) = 1.796 Minutes
EvaluateTime = (meters_ / speed_) * 60
End Function