Question

抱歉这个含糊不清的标题。我不太确定如何命名我正在尝试做的事情。我在工作表中有数据，如下所示：

我想搜索范围中的最小数字，并在y轴和数字上写出名称。然后它忽略该数字并在x轴上搜索最小数字。在同一行中，它水平搜索最小值，排除数字，然后垂直查找。它继续这种方式，直到所有可能性都用尽。这可以用Excel吗？示例输出将是：

y5 : 40
x3: 60
y3: 90
x4: 80
y2 : 85
x3: 75
y1 : 70

等等。

Answer 1

有趣的问题。您应该能够修改以下内容。要运行它，您需要包含对Microsoft Scripting Runtime的引用（在VBA编辑器中的Tools/References下），因为它使用字典数据结构 - 跟踪已经选择的数字的自然选择：

'The following code assumes than Nums is a 1-based 2-dimensional array

Function MinPath(Nums As Variant) As Variant
    Dim counter As Long
    Dim mins As Variant
    Dim PickedNums As New Dictionary
    Dim i As Long, j As Long, m As Long, n As Long
    Dim report As String
    Dim direction As String
    Dim num As Variant
    Dim min As Variant, min_i As Long, min_j As Long
    m = UBound(Nums, 1)
    n = UBound(Nums, 2)

    ReDim mins(1 To m * n)

    min = Nums(1, 1)
    min_i = 1
    min_j = 1
    For i = 1 To m
        For j = 1 To n
            If Nums(i, j) < min Then
                min = Nums(i, j)
                min_i = i
                min_j = j
            End If
        Next j
    Next i

    PickedNums.Add min, 0
    counter = 1
    mins(counter) = Array(min_i, min_j, min)
    direction = "vertical"
    min = Empty

    Do While True
        If direction = "vertical" Then
            For i = 1 To m
                num = Nums(i, min_j)
                If Not PickedNums.Exists(num) Then
                    If IsEmpty(min) Then
                        min = num
                        min_i = i
                    ElseIf num < min Then
                        min = num
                        min_i = i
                    End If
                End If
            Next i

            If IsEmpty(min) Then
                ReDim Preserve mins(1 To counter)
                MinPath = mins
                Exit Function
            Else
                PickedNums.Add min, 0
                counter = counter + 1
                mins(counter) = Array(min_i, min_j, min)
                direction = "horizontal"
            End If
        Else
            'direction = horizontal case
            For j = 1 To n
                num = Nums(min_i, j)
                If Not PickedNums.Exists(num) Then
                    If IsEmpty(min) Then
                        min = num
                        min_j = j
                    ElseIf num < min Then
                        min = num
                        min_j = j
                    End If
                End If
            Next j

            If IsEmpty(min) Then
                ReDim Preserve mins(1 To counter)
                MinPath = mins
                Exit Function
            Else
                PickedNums.Add min, 0
                counter = counter + 1
                mins(counter) = Array(min_i, min_j, min)
                direction = "vertical"
            End If
        End If
    min = Empty
    Loop
End Function

该功能重复搜索行或列（取决于搜索方向）以找到最小的未拾取数字。在每次传递开始时，变量min设置为Empty，直到遇到未挑选的数字。如果传递min后仍然是Empty函数返回。此函数返回一个数组数组，其中每个数组的格式为Array(i,j,min)（例如，第一步中的值为（5,3,40））。 VBA的Array函数返回一个从0开始的数组，因此i（行）坐标位于索引0处且j坐标位于索引1处。您对此数据执行的操作取决于您。例如：

Sub test()
    Dim i As Long, n As Long
    Dim mins As Variant

    mins = MinPath(Range("B2:F6").Value)
    n = UBound(mins)
    For i = 1 To n
        If i Mod 2 = 1 Then 'odd step
            Range("A7").Offset(i).Value = "y" & mins(i)(0) & ":"
        Else 'even step
            Range("A7").Offset(i).Value = "x" & mins(i)(1) & ":"
        End If
        Range("B7").Offset(i).Value = mins(i)(2)
    Next i
End Sub

结果是：

水平和垂直搜索表并打印值

1 个答案: