-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
n1nja
tag
válasz poffsoft #36040 üzenetére
akár
(gépenként az első dátumot kimenti egy tömb-be, majd a tömböt növekvő sorrendbe rendezi és az időpont új sorszámát beírja gépenként a sorting no. oszlopba)
nem szép, de működikPrivate Sub CommandButton1_Click()
Dim currv As Integer
Dim csere As Date
Dim i, j, k, rowcount As Integer
Dim currmachine As String
Dim tomb(1 To 145) As Date
range("R2").Value = "Sorting no."
mint = range("C3").Value
maxt = range("C3").Value
currmachine = " "
rowcount = range("A3", range("A3").End(xlDown)).Rows.Count
Cells(3, 25).Value = rowcount
j = 0
For i = 1 To rowcount
If currmachine <> Cells(i + 2, 1) Then
currmachine = Cells(i + 2, 1)
j = j + 1
tomb(j) = Cells(i + 2, 3)
End If
Next i
For i = 1 To j - 1
For k = i + 1 To j
If tomb(i) > tomb(k) Then
csere = tomb(i)
tomb(i) = tomb(k)
tomb(k) = csere
End If
Next k
Next i
currmachine = " "
For i = 1 To rowcount
If currmachine <> Cells(i + 2, 1) Then
For k = 1 To j
If Cells(i + 2, 3) = tomb(k) Then
currv = k
End If
Next k
End If
Cells(i + 2, 18).Value = currv
Next i
End Sub[ Szerkesztve ]
Új hozzászólás Aktív témák
- AKCIÓ! - STEAM kulcsok /Anuchard, Aragami, Children of Morta, stb. - 2024.04.17.
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Eladó Steam kulcsok kedvező áron!
- Steam, Windows, Origin kulcsok, előfizetések közvetlenül a kiadótól, a LEGJOBB ÁRON!