Isempty（範圍（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個日期：txtdepart和txtfin。 在工作表「dispo」中，每一列都是日期，每一行都是一輛汽車。 如果汽車被某人使用，則兩個日期之間的單元格會合並並着色。

我想要這個代碼檢查每一行（對於每輛車），如果它已經在txtdepart和txtfin之間使用。如果沒有，我得到汽車的號碼（列A的值）並將其寫入我的表單的列表框「listcar」中。

我成功地使它工作，如果只檢查txtdepart，所以我的問題在範圍（cell1，cell2）imo。

任何想法:)？

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

如果你的activesheet比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