Hirdetés
- Samsung Galaxy A53 5G - kevesebbet többért
- Az Amazfit GTR és GTS 3 is szemrevaló lett
- Xiaomi 15T - reakció nélkül nincs egyensúly
- Apple iPhone SE (3. generáció) - szélsebes múltidézés
- Szerkesztett és makrofotók mobillal
- Samsung Galaxy Z Fold5 - toldozás-foldozás
- Xiaomi: Android 16 zápor, zivatar
- Honor Magic6 Pro - kör közepén számok
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- A Galaxy S26-tal együtt késik a One UI 8.5
-
Mobilarena
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
-
Mutt
senior tag
Szia,
...munkafüzet online térben közös használattal lesz feltöltve...ez a részt mit jelent? Sharepoint/OneDrive vagy a shared folder?A weben (Sharepoint/OneDrive) a VBA nem műkődik, helyette van az Office Script (csak olyan munkahelyi licensz esetén ahol ezt az admin engedélyezte). Office Scriptben nincs lehetőség aktuális felhasználó beazonosítására, amit ki lehet próbálni hogy felugró ablakban bekérni a felhasználót és azzal tovább menni.
Ha shared folderben van a fájl, akkor műkődik a VBA, de nagy az esély ilyenkor az adatvesztésre/hibás fájlra.
Alternatív lehetőségek:
1) Esetleg amit lehetne tenni, hogy mindenkinek külön fájlja van és Power Query-vel egyesíteni lehet őket.
2) Microsoft Forms használata (ha van licensz).
3) Harmadik opció ha mindegyik felhasználó tud emailt küldeni, akkor küldhetnek egy emailt (pl. elég ha a tárgyba beleteszik honnan dolgoznak, a többi jön a feladóból és email dátumából). Ezt lehet Power Query-vel vagy azonnal Power Automate-el összesíteni egy fájlba (utóbbi megint licensztől függ).üdv
-
Fferi50
Topikgazda
Szia!
Elviekben:
Az Application.Username visszaadja annak a felhasználónak a Windows nevét, aki éppen használja a munkafüzetet. Az első sorban levő neveket ehhez kell hasonlítani úgy, hogy a cella értékéből elhagyod az utolsó 6 karaktert. Így megkapod azt az oszlopot, amit felszabadíthatsz.
Alapesetben a munkalapnak zároltnak kell lennie, hogy a korlátozások érvényesülhessenek. Viszont a zárolást közös használat esetén úgy emlékszem nem lehet feloldani csak kizárólagos megnyitással.
Úgy gondolom mégis inkább a szerkeszthető terület megadása lesz a megoldás, amit előre definiálhatsz és hozzárendelhetsz a Windows userhez. Ezt utána az Excel maga ellenőrzi, a munkalap azon területeit, amelyeket szerkeszteni lehet, a hozzárendelésnél fel kell szabadítani, majd az egész munkalapot zárolni.
Üdv. -
Mutt
senior tag
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
Új hozzászólás Aktív témák
- Samsung Galaxy A53 5G - kevesebbet többért
- Miskolc és környéke adok-veszek-beszélgetek
- Pánikban a világ a Radeon RX 5000 és 6000 sorozat támogatása miatt
- Kedvenc zene a mai napra
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Goddess of Victory:Nikke
- Kerékpárosok, bringások ide!
- Építő/felújító topik
- Az Amazfit GTR és GTS 3 is szemrevaló lett
- OLED TV topic
- További aktív témák...
- KERESEK: Poly Voyager 4320 M UC USB-C 218478-02M Part number: 77Z30AA
- Telefon felvásárlás!! iPhone 15/iPhone 15 Plus/iPhone 15 Pro/iPhone 15 Pro Max
- Lenovo Thinkpad 13 G2 Intel i3-7100 laptop (hiányos, de működik)
- ASUS TUF Dash F15 - 15.6"FHD 144Hz - i7-11370H - 16GB - 1,5TB SSD - RTX 3060 6GB - Win11
- GYÖNYÖRŰ iPhone Xs Max 256GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3537, 100% Akkumulátor
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50

