(范围(cell1，cell2))

Question

我遇到了一个问题，我的一个代码，我希望你们中的一个能救我。

这是我的代码：

Private Sub cmdrecherche_Click()
Dim db As Range
Dim ligne As Integer
Dim L As Long
Dim Cd As Long
Dim Cf As Long
Dim maxc As Long
Dim maxl As Long
Dim cardispo As Integer

Set dispo = ActiveWorkbook.Sheets("Dispo")
Set booking = ActiveWorkbook.Sheets("booking")

maxc = dispo.Range("A1").End(xlToRight).Column
maxl = dispo.Range("A1").End(xlDown).Row

For Cd = 5 To maxc
If Format(CDate(dispo.Cells(1, Cd).Value), "mm-dd-yyyy") = Format(CDate      (txtdepart), "mm-dd-yyyy") Then
    For Cf = 5 To maxc
        If Format(CDate(dispo.Cells(1, Cf).Value), "mm-dd-yyyy") = Format(CDate(txtfin), "mm-dd-yyyy") Then
            For L = 2 To maxl
                If IsEmpty(Range(dispo.Cells(L, Cd), dispo.Cells(L, Cf))) Then
                cardispo = dispo.Range("A" & L).Value
                listcar.AddItem cardispo
                End If
            Next L
        End If
    Next Cf
End If
Next Cd

End Sub

我从表格2中得到日期: txtfin和txtfin。在单张中，每一列都是一个日期，每一行都是一辆汽车。如果汽车被某人使用，两个日期之间的单元格将被合并并着色。

我希望这段代码检查每一行(对于每一辆车)是否已经在txtfin和txtfin之间使用了。如果没有，我将得到汽车的编号(A列的值)，并将其写入表单的列表框"listcar“中。

如果只检查txtdepart，所以我的问题就在范围内(cell1，cell2)，所以我成功地使它工作起来。

知道吗:)？

Answer 1

解决了我的问题(也许不是一种非常“漂亮”的方法，但它有效)：

Private Sub cmdrecherche_Click()
Dim db As Range
Dim ligne As Integer
Dim L As Long
Dim Cd As Long 'column of starting date
Dim Cf As Long 'column of ending date
Dim cdf As Long
Dim maxc As Long
Dim maxl As Long
Dim cardispo As Integer
Dim r As Integer
Dim count As Integer


Set dispo = ActiveWorkbook.Sheets("Dispo")
Set booking = ActiveWorkbook.Sheets("booking")

With dispo
maxc = .Range("A1").End(xlToRight).Column
maxl = .Range("A1").End(xlDown).Row

For Cd = 5 To maxc
    If Format(CDate(.Cells(1, Cd).Value), "mm-dd-yyyy") = Format(CDate(txtdepart), "mm-dd-yyyy") Then
        For Cf = 5 To maxc
            If Format(CDate(.Cells(1, Cf).Value), "mm-dd-yyyy") = Format(CDate(txtfin), "mm-dd-yyyy") Then
            cdf = Cf - Cd
                For L = 2 To maxl
                count = 0
                    For r = 0 To cdf
                        If IsEmpty(.Cells(L, Cd).Offset(0, r)) Then
                        count = count + 0
                        Else
                        count = count + 1
                        End If
                    Next r
                    If count = 0 Then
                    cardispo = .Range("A" & L).Value
                    listcar.AddItem cardispo
                    End If
                Next L
            End If
        Next Cf
    End If
 Next Cd
 End With

 End Sub

( Thx寻求帮助:)

Answer 2

如果您的活动单与dispo不同，下面的行可能是问题所在。

改变这一点：

< If IsEmpty(Range(dispo.Cells(L, Cd), dispo.Cells(L, Cf))) Then
> If IsEmpty(dispo.Range(dispo.Cells(L, Cd)) And IsEmpty(dispo.Cells(L, Cf)) Then

或者类似于：

With dispo
    maxc = .Range("A1").End(xlToRight).Column
    maxl = .Range("A1").End(xlDown).Row

    For Cd = 5 To maxc
        If Format(CDate(.Cells(1, Cd).Value), "mm-dd-yyyy") = Format(CDate(txtdepart), "mm-dd-yyyy") Then
            For Cf = 5 To maxc
                If Format(CDate(.Cells(1, Cf).Value), "mm-dd-yyyy") = Format(CDate(txtfin), "mm-dd-yyyy") Then
                    For L = 2 To maxl
                        If IsEmpty(.Cells(L, Cd)) And IsEmpty(.Cells(L, Cf)) Then
                            cardispo = .Range("A" & L).Value
                            listcar.AddItem cardispo
                        End If
                    Next L
                End If
            Next Cf
        End If
    Next Cd
End With