Új hozzászólás Aktív témák

• #53136 Mutt senior tag Owlet #53134

  Új Válasz 2024-09-02 21:57:25 #53136

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz Owlet #53134 üzenetére

  Szia,

  Neked kell sorba rendezni a dátumokat, erre van több megoldás is. A QuickSort elég gyors nagyobb adatsoron is.

  Én még annyit kavartam, hogy ha előfordulnának ismétlődő szabad dátumok, akkor azt egy collection-el előbb kiszűrtem.

  Private Sub FillDates2()
Dim ws As Worksheet
Dim cell As Range
Dim greenColor As Long
greenColor = RGB(0, 204, 102)

Set ws = ThisWorkbook.Sheets("2025")

Dim datumokColl As New Collection 'collection esetén csak egyedi értékek maradnak meg
Dim datumokArr() 'majd ebbe a tömbbe másoljuk át a kapott értékeket
Dim c As Long

On Error Resume Next 'collection leáll ha duplikáció van, így átugorjuk ezt
For Each cell In ws.UsedRange
If cell.Interior.Color = greenColor And IsDate(cell.Value) Then
datumokColl.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0

'ha van szabad dátum akkor lehet tovább menni
If datumokColl.Count > 0 Then

'a szabad dátumokat egy tömbbe kell másolni, létrehozzuk a megfelelõ méretû tömböt
ReDim datumokArr(1 To datumokColl.Count)

'átmásoljuk a collection tartalmát a tömbbe
For c = 1 To datumokColl.Count
datumokArr(c) = datumokColl(c)
Next c

'növekvõ sorba rendezzük a dátumokat
Call QuickSort(datumokArr, 1, datumokColl.Count)

'comboxhoz adjuk a dátumokat
For c = 1 To UBound(datumokArr)
Me.ErkezesiDatum.AddItem Format(datumokArr(c), "yyyy.mm.dd")
Me.TavozasiDatum.AddItem Format(datumokArr(c), "yyyy.mm.dd")
Next c

End If

End Sub

'https://stackoverflow.com/questions/152319/vba-array-sort-function
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long

tmpLow = inLow
tmpHi = inHi

pivot = vArray((inLow + inHi) \ 2)

While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend

While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend

If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend

If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

  üdv

• #53135 Delila_1 veterán Owlet #53134

  Új Válasz 2024-09-02 15:46:14 #53135

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Owlet #53134 üzenetére

  A For Each a tartomány első során halad és vizsgál balról jobbra, majd veszi a következő sort. Ha ez nem felel meg, akkor 2 For-Next ciklust vegyél fel, az első az oszlopokon, majd azon belül a sorokon haladjon.

Új hozzászólás Aktív témák