Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Losowe dodawanie minut do godziny

sekator2 · Fan Excela Posty: 65

Witam,
mam kolumnę A z godzinami np 15:00 16:10 14:20 13:30
Chciałbym aby makro w kolumnie B dodał mi losowo do tych godzin np 40 minut 50 minut 80 minut 100minut

pozdrawiam

godziny.zip

Pobierz Plik ściągnięto 8 raz(y) 5.43 KB

hurgadion · Excel Expert **Pomógł:** 767 razy Posty: 1302

Witam,
spróbuj odpalić makro:

Kod:

Sub DodajLosowo()
Dim tbl1(), tbl2(), i&

ReDim tbl1(1 To 4)
ReDim tbl2(1 To 4)
tbl1 = Array(4 / 144, 5 / 144, 8 / 144, 10 / 144)
tbl2 = RndInt(4)

For i = 1 To 4
Cells(i, 2).Value = Cells(i, 1).Value + tbl1(tbl2(i) - 1)
Range("B" & i).NumberFormat = "hh:mm"
Next i
End Sub

Function RndInt(a As Long)
Dim V() As Variant, Val As Variant
Dim i&, j&, r&, c&, b&, d&
Dim t1 As Variant, t2 As Variant

Randomize

ReDim V(1 To a)
ReDim Val(1 To 2, 1 To a)

For i = 1 To a
Val(1, i) = Rnd
Val(2, i) = i
Next i

For i = 1 To a
For j = i + 1 To a
If Val(1, i) > Val(1, j) Then
t1 = Val(1, j)
t2 = Val(2, j)
Val(1, j) = Val(1, i)
Val(2, j) = Val(2, i)
Val(1, i) = t1
Val(2, i) = t2
End If
Next j
Next i

i = 0
For r = 1 To a
i = i + 1
V(i) = Val(2, i)
Next r

RndInt = V
End Function

Pozdrawiam.

sekator2 · Fan Excela Posty: 65

W tym przykładzie mam akurat 4 wiersza ale tez mogę mieć więcej:(
A gdzie mogę w kodzie zmienić zakresy godzin że np 100 minut zwiększyć na 200

hurgadion · Excel Expert **Pomógł:** 767 razy Posty: 1302

Trzeba zmienić ciut główne makro

Kod:

Sub DodajLosowo()
Dim tbl1(), tbl2(), i&, lwierszy&

lwierszy = 4
ReDim tbl1(1 To lwierszy)
ReDim tbl2(1 To lwierszy)
tbl1 = Array(4 / 144, 5 / 144, 8 / 144, 10 / 144)
tbl2 = RndInt(lwierszy)

For i = 1 To lwierszy
Cells(i, 2).Value = Cells(i, 1).Value + tbl1(tbl2(i) - 1)
Range("B" & i).NumberFormat = "hh:mm"
Next i
End Sub

Jeżeli masz więcej niż 4 czasy, to trzeba rozszerzyć macierz (Array) o dodatkowe elementy postaci lminut/1440, pozdrawiam.

sekator2 · Fan Excela Posty: 65

a to muszę zmieniać za każdym razem lwierszy. A można tak żebym zaznaczał te komórki które chciałbym żeby mi w kolumnie B losowo dodał godziny.

hurgadion · Excel Expert **Pomógł:** 767 razy Posty: 1302

To już wymaga znacznej przeróbki powyższego makra, na drugi raz proszę sprecyzować swoje oczekiwania, pozdrawiam.

Kaper · Excel Expert **Pomógł:** 1151 razy Posty: 1626

No fakt, na to się nie zanosiło w pierwszym poście.
Poza tym oprócz 40, 50, 80, 100 czy 200 minut powiino losować też inne wielokrotności.

Ja bym to zrobił tak:

Kod:

Sub dodaj_losowa_wielokrotnosc_min()
Const max_minut As Long = 100
Const min_minut As Long = 40
Const wielokrotnosc As Long = 10
Dim komorka As Range
Dim licznik As Long
Randomize
licznik = 0
On Error GoTo kicha
For Each komorka In Selection
If komorka.Value <> "" And IsNumeric(komorka.Value) Then
komorka.Value = komorka.Value + Int((min_minut + Rnd * _
(max_minut - min_minut + wielokrotnosc)) _
/ wielokrotnosc) * wielokrotnosc / 1440
licznik = licznik + 1
End If
Next komorka
kicha:
On Error GoTo 0
If licznik < 1 Then MsgBox "Przed wywołaniem makra zaznacz obszar zawierający co najmniej jedną komórkę z wpisanym czasem", vbCritical
End Sub

Trzy pierwsze stałe można oczywiscie pozmieniać do swoich potrzeb. aby np. było losowo dodane 0;5;10 lub 15 minut początek powinien być:

Kod:

Const max_minut As Long = 15
Const min_minut As Long = 0
Const wielokrotnosc As Long = 5

Zaznaczamy jakiś obszar zawierający czasy (możesz też zaznaczyć obszar ich nie zawierający) i uruchamiamy makro (np. Alt+F8).

Pozdrawiam

dodawanie_losowych_10min__Kaper.zip

Pobierz Plik ściągnięto 11 raz(y) 9.94 KB

hurgadion · Excel Expert **Pomógł:** 767 razy Posty: 1302

Uwaga

Jeżeli dobrze zrozumiałem powyższy kod, to moje rozwiązanie działa jednoznacznie (bez powtórzeń), rozwiązanie Kapera jest z powtórzeniami.

Kaper · Excel Expert **Pomógł:** 1151 razy Posty: 1626

zdecydowanie tak.

sekator2 · Fan Excela Posty: 65

Kaper bardzo fajne rozwiązanie:) ale co mam zrobić jak bym chciał żeby zaznaczać kolumnę A ale wynik losowanie był w kolumnie B. a A zostaje bez zmian.

hurgadion · Excel Expert **Pomógł:** 767 razy Posty: 1302

Wydaje mi się, że wystarczy zmienić linijkę:

Kod:

komorka.Value = komorka.Value...

na linijkę:

Kod:

komorka.Offset(0, 1).Value = komorka.Value...

Pozdrawiam.