Question

在我的工作簿中，我必须使用表格。

表1从A1：F10开始，并显示了机器分配。表2来自G1：K10，并显示了机器的存储空间。

现在有一个按钮，我想模拟哪个存储应该用于哪台机器。

在C列中表示必须生产机器的日期。在第一列中，可以使用存储的日期。

例如：第一台计算机必须在2018年8月15日开始运行，如何检查第一列中哪个日期最接近2018年8月15日？

到目前为止，这是我的代码：

Private Sub CommandButton1_Click()
    Dim lastrow as Long

    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    for a = 1 to lastrow
        If Cells(a, 1) = "Machine Name" And _    ' Find the specific machine
        Cells(a, 4) = "" Then                    ' In this cell the serial number of the storage should be added
            ' Now check if Storage for this machine is ready to use.
            For b = 1 to lastrow
                If Cells(b, 8) = "123" And _    ' Serial Number of the Storage
                Cells(b, 10) = "" Then          ' In this Cell serial number of the machine should be added
                    ' Here it should check which Date in Column I is the closest to the date in Column C
                    Cells(a, 4).Value = Cells(b, 8)
                    Cells(b, 10).Value = Cells(a, 2)
               End If
           Next b
       End If
    Next a
End Sub

我已经尝试从Find closest date to current date in VBA更改代码，但是我无法按照我想要的方式来使用它。

我希望有人可以帮助我解决我的问题。谢谢

编辑：

在图片中，您可以看到一个表格外观的示例：

Answer 1

您没有在开始之前指定要在哪一个最近的日期，所以我只是在C列中将日期添加为开始日期的注释。

Sub FindClosestBeforeDate()
    Dim ws As Worksheet
    Dim lLastReadyUsed As Long
    Dim lLastStartUsed As Long
    Dim dt As String
    Dim temp As Variant

    Set ws = Application.ThisWorkbook.ActiveSheet
    lLastStartUsed = ws.Cells(Rows.Count, "C").End(xlUp).Row
    lLastReadyUsed = ws.Cells(Rows.Count, "I").End(xlUp).Row

    'Delete previous comments
    For l = 2 To lLastStartUsed
        If Not Range("c" & l).Comment Is Nothing Then
            ws.Range("C" & l).Comment.Delete
        End If
    Next l

    'add comments with closeste date before startdate
    For l = 2 To lLastStartUsed
        For i = 2 To lLastReadyUsed
            If DateDiff("D", ws.Range("C" & l).value, ws.Range("I" & i).value) < 0 Then
                If IsEmpty(temp) Then
                    temp = DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value)
                    dt = ws.Range("I" & i).value
                ElseIf temp < DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value) Then
                    temp = DateDiff("D", ws.Range("C" & 3).value, ws.Range("I" & i).value)
                    dt = ws.Range("I" & i).value
                End If
            End If
        Next i
        temp = Empty
        ws.Range("C" & l).AddComment dt
    Next l
End Sub

希望这对您有帮助

Answer 2

以您的示例为例，我假设您想要

开始= 2018年6月15日，恩德= 2018年3月14日
开始= 2018年8月25日，恩德= 2018年7月26日

添加此函数并像YourCell.Value = getClosestDateBefore(StartCell.Value, Range("I2:I9"))一样调用它

Function getClosestDateBefore(d As Date, RefDateRange As Range) As Date
    Dim i As Long, ref_date As Date, diff As Double, best_diff As Double
    best_diff = -10000000
    With RefDateRange
        For i = 1 To .Cells.Count
            ref_date = .Cells(i).Value2
            diff = ref_date - d
            If diff < 0 And diff > best_diff Then
                best_diff = diff
                getClosestDateBefore = ref_date
            End If
        Next i
    End With
End Function

VBA查找最接近特定日期的日期

2 个答案: