Question

我正在尝试使用excel进行自动调度程序。

例如，每个号码都是指定给某一天的某个工作。

       1/2 1/3 1/4 1/5
Tom     1   2   2   ?
Justin  2   3   1   ?
Mary    3       3   ?
Sam         1       ?

Check   O   O   X   ?   ## check is like =if(b2=c2,"O","X")

我想确定的事情是每个人从昨天起都有不同的工作。

我的想法

while 
    randomly distribute jobs for 1/5
wend CheckCell = "O"

但是我发现在vba脚本中检查单元格并不起作用 - 单元格在每个while循环中都没有更新。

你能给我一些关于这类程序的指针吗？因为我是vbaScript的新手，所以请各种帮助。

Answer 1

使用VBA，我确信有更好的方法可以做到这一点，但是这将检查倒数第二列中的值与最后一列的值，如果它们匹配，则将“O”写入最后一列，否则它会写“X”：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

counter = 0 'set counter

For i = 2 To LastRow 'loop through penultimate column and add values to array
    If ws.Cells(i, LastCol - 1).Value <> "" Then
    Values = Values & ws.Cells(i, LastCol - 1) & ","
    End If
Next i

Values = Left(Values, Len(Values) - 1)
Values = Split(Values, ",") 'split values into array

For i = 2 To LastRow 'loop through last column and add values to array
    If ws.Cells(i, LastCol).Value <> "" Then
    ValuesCheck = ValuesCheck & ws.Cells(i, LastCol) & ","
    End If
Next i
ValuesCheck = Left(ValuesCheck, Len(ValuesCheck) - 1)
ValuesCheck = Split(ValuesCheck, ",")

For y = LBound(Values) To UBound(Values) 'loop through both arrays to find all values match
    For x = LBound(ValuesCheck) To UBound(ValuesCheck)
        If Values(y) = ValuesCheck(x) Then counter = counter + 1
    Next x

Next y
If counter = UBound(Values) + 1 Then 'if values match
    ws.Cells(LastRow + 1, LastCol).Value = "O"
Else 'else write X
    ws.Cells(LastRow + 1, LastCol).Value = "X"
End If
End Sub

Answer 2

只是为了澄清您是否希望在vba或支票中实现随机数。

要进行检查，最好的方法是将区域设置为范围，然后使用单元格（r，c）代码检查每个区域，如下所示

Sub checker()
Dim rng As Range
Dim r As Integer, c As Integer

Set rng = Selection
For r = 1 To rng.Rows.Count
    For c = 1 To rng.Columns.Count
        If rng.Cells(r, c) = rng.Cells(r, c + 1) Then
            rng.Cells(r, c).Interior.Color = RGB(255, 0, 0)
        End If
    Next c
Next r


End Sub

此宏检查您为问题选择的文本，如果它与右侧的值匹配，则将单元格更改为红色。为了使它适用于您，将set rng = selection更改为您的范围并将rng.Cells（r，c）.Interior.Color = RGB（255,0,0）更改为您想要的操作

Answer 3

与其他答案截然不同的方法添加此功能：

Function PickJob(AvailableJobs As String, AvoidJob As String)
    Dim MaxTries As Integer
    Dim RandomJob As String
    Dim Jobs() As String
    Jobs = Split(AvailableJobs, ",")

    MaxTries = 100
    Do
        MaxTries = MaxTries - 1
        If MaxTries = 0 Then
            MsgBox "Could find fitting job"
            End
        End If
        RandomJob = Jobs(Int((1 + UBound(Jobs)) * Rnd()))
    Loop Until RandomJob <> AvoidJob
    PickJob = RandomJob
End Function

并将此公式放在您的表格中

=PickJob("1,2,3",D2)

其中D2指向的是上一个作业

自动调度

3 个答案: