temp2inaits-blog - Tumblr blog

sim

Option Explicit Option Base 1

Dim dicOrder As New Dictionary Dim arrOrder() As String Dim dicOpeNum As New Dictionary Dim arrOpeNum() As Integer Dim outputData() As Variant

Sub Main()

Dim startTime As Single: startTime = Timer

GetDefData

Matching

OutputResult

Debug.Print "Main : " & Format((Timer - startTime) * 1000, "0.000") & " ms"

End Sub

Sub GetDefData()

Dim tmpArr As Variant Dim i As Integer, j As Integer

'' 優先度 tmpArr = ThisWorkbook.Names("def_優先度").RefersToRange

ReDim Preserve arrOrder(UBound(tmpArr), 3)

For i = 1 To UBound(tmpArr) For j = 1 To 3 arrOrder(i, j) = tmpArr(i, j + 1) Next j dicOrder(tmpArr(i, 1)) = i Next i tmpArr = Empty

'dbg' Dim itm As Variant For Each itm In dicOrder Debug.Print "dicOrder.key = " & itm & vbTab & " | "; For i = 1 To 3 Debug.Print vbTab & arrOrder(dicOrder.Item(itm), i); Next i Debug.Print vbNullString Next itm

'' 人数 tmpArr = ThisWorkbook.Names("def_人数").RefersToRange

ReDim Preserve arrOpeNum(UBound(tmpArr), 3)

For i = 1 To UBound(tmpArr) For j = 1 To 3 arrOpeNum(i, j) = tmpArr(i, j + 1) Next j dicOpeNum(CStr(CDate(tmpArr(i, 1)))) = i Next i tmpArr = Empty

'dbg' ' dim itm as Variant For Each itm In dicOpeNum Debug.Print "dicOpeNum.key = " & itm & vbTab & " | "; For i = 1 To 3 Debug.Print vbTab & arrOpeNum(dicOpeNum.Item(itm), i); Next i Debug.Print vbNullString Next itm

End Sub

Sub Matching()

Dim targetData(6) As Variant Dim outputRowData(11) As Variant

Dim arrQueue As Variant With ThisWorkbook.Worksheets(1) arrQueue = .Range(.Cells(START_ROW + 1, START_COL), .Cells(END_ROW, END_COL)) End With

Dim responsibleOpeNum As New Dictionary: responsibleOpeNum.RemoveAll ' initialize [0:00] Dim procHour As String: procHour = CStr(CDate(TimeSerial(0, 0, 0))) responsibleOpeNum("種別1") = arrOpeNum(dicOpeNum.Item(procHour), 1) responsibleOpeNum("種別2") = arrOpeNum(dicOpeNum.Item(procHour), 2) responsibleOpeNum("種別3") = arrOpeNum(dicOpeNum.Item(procHour), 3)

Dim callingOpeStatus As New Dictionary: callingOpeStatus.RemoveAll callingOpeStatus("種別1") = "" callingOpeStatus("種別2") = "" callingOpeStatus("種別3") = ""

Dim idx As Long Dim endIdx As Long: endIdx = UBound(arrQueue) Dim i As Integer

Dim oIdx As Integer Dim resultId As Long

Dim itmX As Variant, itmY As Variant Dim tmpArr As Variant, tmpArr2() As Variant, tmpArr3 As Variant Dim tmpStr As String, setStr As String Dim x As Integer

Dim targetOpeType As String

' For idx = LBound(arrQueue) To endIdx For idx = LBound(arrQueue) To 100 For i = 1 To END_COL targetData(i) = arrQueue(idx, i) Next i

If (Minute(CDate(procHour)) <> Minute(CDate(targetData(2)))) Then procHour = CStr(CDate(targetData(2))) For Each itmX In callingOpeStatus tmpArr = Split(callingOpeStatus.Item(itmX), ":") If (UBound(tmpArr) > 0) Then For x = 0 To UBound(tmpArr) ReDim tmpArr2(1) If (tmpArr(x) <> "") Then If (tmpArr(x) <= 1) Then responsibleOpeNum.Item(itmX) = responsibleOpeNum.Item(itmX) + 1 Else ReDim Preserve tmpArr2(x + 1) tmpArr2(x + 1) = tmpArr(x) - 1 End If callingOpeStatus.Item(itmX) = Join(tmpArr2, ":") End If Next x Erase tmpArr2 End If Next itmX End If

If (Hour(CDate(procHour)) <> Hour(CDate(targetData(2)))) Then Debug.Print "* procHour = " & procHour & " | targetData(2) = " & CDate(targetData(2)) procHour = CStr(CDate(targetData(2))) responsibleOpeNum("種別1") = arrOpeNum(dicOpeNum.Item(procHour), 1) responsibleOpeNum("種別2") = arrOpeNum(dicOpeNum.Item(procHour), 2) responsibleOpeNum("種別3") = arrOpeNum(dicOpeNum.Item(procHour), 3) End If

For oIdx = 1 To 3 targetOpeType = arrOrder(dicOrder(targetData(3)), oIdx) If (targetOpeType = "なし") Then ' 溢れ or 待ち outputRowData(9) = "溢れ／待ち" Debug.Print "[" & targetData(1) & "] -> 溢れ／待ち" Exit For End If

If (responsibleOpeNum(targetOpeType) > 0) Then ' 応答 outputRowData(9) = "応答" outputRowData(10) = CDate(targetData(2)) + TimeSerial(0, 4, 0) outputRowData(11) = targetOpeType

responsibleOpeNum.Item(targetOpeType) = responsibleOpeNum.Item(targetOpeType) - 1 callingOpeStatus.Item(targetOpeType) = callingOpeStatus.Item(targetOpeType) & ":" & CStr(4)

Debug.Print "[" & targetData(1) & "] -> 応答 | targetOpeType = " & targetOpeType & " | 空き = " & responsibleOpeNum.Item(targetOpeType) Exit For End If Next oIdx

If (outputRowData(9) = "") Then ' 溢れ（空きなし） outputRowData(9) = "空きなし" Debug.Print "[" & targetData(1) & "] -> 空きなし" End If

resultId = resultId + 1 outputRowData(1) = resultId outputRowData(2) = CDate(targetData(2)) outputRowData(3) = targetData(1) outputRowData(4) = CDate(targetData(2)) outputRowData(5) = targetData(3) outputRowData(6) = targetData(4) outputRowData(7) = targetData(5) outputRowData(8) = targetData(6)

ReDim Preserve outputData(resultId) outputData(resultId) = outputRowData

Erase outputRowData Erase targetData targetOpeType = Empty Next idx

End Sub

Sub OutputResult()

End Sub