0

私のコードの 1 つで問題が発生しました。誰かが私を救ってくれることを願っています。

ここに私のコードがあります:

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をチェックするだけでうまくいくので、私の問題は範囲（cell1、cell2）imoにあります。

何か案が ：） ？

4

2 に答える 2

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 に答える