- Az AI miatt vehetnek sokan új iPhone-t
- Facebook és Messenger
- Nem szavazza meg Musk 56 milliárd dolláros csomagját a norvég állami vagyonalap
- Ömlenek a fiatalok a Facebookra
- Docker konténerizálás
- Aliexpress tapasztalatok
- Csinált valamit a Nokia: megváltoznak a telefonhívások
- Xiaomi AX3600 WiFi 6 AIoT Router
- Kanada feltalálta a Netflix-adót
- Tarr Kft. kábeltv, internet, telefon
-
IT café
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
-
félisten
Berakom ezt a makrót is, ha másért nem, hátha mások találnak benne a későbbiekben hasznosítható ötletet.
Private Sub CommandButton1_Click()
'FSCD_MIN_MAX_With_Unique Macro
Dim MyCell As Range
Dim MyCollection As New Collection
Dim MyValue As Variant
Dim MyTypeSrcRange As Range, MyTimeSrcRange As Range, MyDestRange As Range
Dim MyTypeColumnRow As Range, MyTimeColumnRow As Range
Dim MySrcColumn As String
Dim MySrcRow As Integer
Dim MyFxs As WorksheetFunction
Set MyFxs = Application.WorksheetFunction
Application.EnableEvents = False
Application.ScreenUpdating = False
'A TÍPUS adatok ettől a cellától kezdődnek
Set MyTypeColumnRow = Range("A2")
'Az IDŐ adatok ettől a cellától kezdődnek
Set MyTimeColumnRow = Range("B2")
'Az elkészítendő TÁBLÁZAT kezdőcellája (táblázat bal-felső sarka)
Set MyDestRange = Range("C2")
Set MyTypeSrcRange = Range(MyTypeColumnRow.Address & ":" & Chr(MyTypeColumnRow.Column + 64) & Cells(Rows.Count, Chr(MyTypeColumnRow.Column + 64)).End(xlUp).Row)
Set MyTimeSrcRange = Range(MyTimeColumnRow.Address & ":" & Chr(MyTimeColumnRow.Column + 64) & Cells(Rows.Count, Chr(MyTimeColumnRow.Column + 64)).End(xlUp).Row)
For Each MyCell In MyTypeSrcRange
On Error Resume Next
MyCollection.Add MyCell.Value, CStr(MyCell.Value)
Next MyCell
i = 1
MyDestRange.Offset(0, 0) = "Típus"
MyDestRange.Offset(0, 1) = "MIN"
MyDestRange.Offset(0, 2) = "MAX"
For Each MyValue In MyCollection
MyDestRange.Offset(i, 0).NumberFormat = "@"
MyDestRange.Offset(i, 0) = MyValue
MyDestRange.Offset(i, 1).NumberFormat = "[h]:mm:ss"
MyDestRange.Offset(i, 1).FormulaArray = "=MIN(IF(" & MyTypeSrcRange.Address & "=""" & MyDestRange.Offset(i, 0) & """," & MyTimeSrcRange.Address & "))"
MyDestRange.Offset(i, 2).NumberFormat = "[h]:mm:ss"
MyDestRange.Offset(i, 2).FormulaArray = "=MAX(IF(" & MyTypeSrcRange.Address & "=""" & MyDestRange.Offset(i, 0) & """," & MyTimeSrcRange.Address & "))"
i = i + 1
Next MyValue
Set MyTypeSrcRange = Nothing
Set MyTimeSrcRange = Nothing
Set MyDestRange = Nothing
Set MyTypeColumnRowe = Nothing
Set MyTimeColumnRowe = Nothing
Set MyCollection = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
Új hozzászólás Aktív témák
- Eladó Steam kulcsok kedvező áron!
- 10 Darab PC Játék (Bontatlanul!) Egyben 6990Ft.-ért Foxal!!!
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- AKCIÓ! - STEAM kulcsok / Punch Club, Oddworld: Soulstorm, Children of Morta, stb. - 2024.05.16.
- Erdeti Half life cd-t keresek
- Office Professional Plus 2013, 2016, 2019, 2021 RETAIL licenckulcsok - MEGA Akció!
- Vírusirtó, Antivirus, VPN licenckulcsok - kedvezményes ajánlatok (frissítve: 2024. 05. 01.)
- Steelbookok, gyűjtői darabok, relikviák
- Windows 10, 11 Professional, Home, Enterprise licenckulcsok 64, 32 bit - MEGA Akció!
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen