0

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

这是我的代码:

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 中得到日期:txtdepart 和 txtfin。在工作表“dispo”中,每一列是一个日期,每一行是一辆汽车。如果汽车被某人使用,则 2 个日期之间的单元格将合并并着色。

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

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

任何想法 :) ?

4

2 回答 2

0

如果您的活动表与 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
于 2013-08-02T13:43:02.110 回答
0

解决了我的问题(可能不是一种非常“漂亮”的方法,但它有效):

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

谢谢你的帮助:)

于 2013-08-05T10:16:02.030 回答