- Honor 90 - modellalkat
- Samsung Galaxy S10e - esszenciális
- Samsung Galaxy Z Fold4 - egyre megy, honnan nézed
- Olyan telefon lett az idei foci EB hivatalos mobilja, ami nem kapható Európában
- Spanyolországban kezd a Vivo V40 5G és V40 Lite 5G
- MIUI / HyperOS topik
- Samsung Galaxy Watch4 és Watch4 Classic - próbawearzió
- uleFone Power
- Meater 2 Plus - medium rare
- iPhone topik
Hirdetés
-
Retro Kocka Kuckó 2024
lo Megint eltelt egy esztendő, ezért mögyünk retrokockulni Vásárhelyre! Gyere velünk gyereknapon!
-
Picit erősít a tempón az új Arc meghajtó
ph A 31.0.101.5590-es, WHQL aláírással rendelkező csomag két új profilt is kínál.
-
Elindíthatja Kínában az FSD tesztjét a Tesla
it Sanghaj 10 Tesla jármű számára engedélyezte a tesztet, így előkészíthetik az FSD kínai indulását.
-
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
-
Delila_1
Topikgazda
válasz
jaszy83 #13345 üzenetére
Gyorsabb futást eredményez az újabb makró, és csak a két lap nevét kell módosítani, meg esetleg az 5000 sort.
Sub Rendez()
Dim sor As Long, usor As Long, oszlop As Integer
Dim WS As Worksheet, WSF As Worksheet
Application.ScreenUpdating = False
Set WS = Sheets("Munka3") '***************
Set WSF = Sheets("Felvitel") '***************
usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
WS.Select
oszlop = Range("XFD1").End(xlToLeft).Column
'Előző cella-egyesítések megszüntetése
Columns(1).MergeCells = False
'Előző adatok törlése
Rows("2:5000").Delete '***************
'Adatok a Felvitel lapról a Munka3-ra
WSF.Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy WS.Range("A2")
WS.Select
'Rendezés
Range(Cells(1, 1), Cells(usor, oszlop)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:C" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Cellaegyesítés az A oszlopban
For sor = usor To 2 Step -1
If Cells(sor, 1) = Cells(sor - 1, 1) Then
Cells(sor - 1, 1) = ""
Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
End If
Next
'Keret
Range(Cells(1, 1), Cells(usor, oszlop)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeBottom).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Application.ScreenUpdating = False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- Vicces képek
- Steam, GOG, Epic Store, Humble Store, Xbox PC Game Pass, Origin Access, uPlay+, Apple Arcade felhasználók barátságos izgulós topikja
- M0ng00se: Northwood vs Prescott + tuning: a tesztek
- Ingatlanos topic!
- Nagy pofon: lőttek a Meta európai AI-tervének
- Ukrajnai háború
- Halasztja a Recall funkció aktiválását a Microsoft
- Call of Duty: Modern Warfare III (2023)
- ViewSonic VX2779-HD-Pro: megfizethető gamer monitor
- Honor 90 - modellalkat
- További aktív témák...
- Autómatricák a legjobb minőségben, több ezer minta! PH tagoknak 30% kedvezmény!
- Védje meg számítógépét a vírusoktól!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Canva Pro előfizetés - 1 éves