Hirdetés
- Milyen videókártyát?
- ZIDOO médialejátszók
- TCL LCD és LED TV-k
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
- Dobozcserére kárhoztatja asztali csúcs-CPU-ját az Intel
- 3D nyomtatás
- Sok hűhó négyszázért: AMD Ryzen 7 9850X3D
- Projektor topic
- Fejhallgató erősítő és DAC topik
- Gaming notebook topik
-
PROHARDVER!
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
veterán
válasz
jaszy83
#13384
üzenetére
Nem mondhatom, hogy teljesen értem, ritkán húzgálok többszáz kilós súlyokat.
Most azt gondolom, hogy amelyik súly szerepel a Felvitel lap D oszlopában a név mellett, ahhoz a súlyhoz kell K-t írni a Munka3 lapon.
De honnan jön a H?
Makró:
Sub Rendez_2()
Dim sor As Long, usor As Long, oszlop As Integer, uoszlop 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
uoszlop = Range("IV1").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:C" & usor).Copy WS.Range("A2")
WS.Select
'Rendezés
Range(Cells(1, 1), Cells(usor, uoszlop)).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, "–" beírása
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
For oszlop = 5 To uoszlop
If Cells(1, oszlop) < WSF.Cells(sor, 4) Then
Cells(sor, oszlop) = "–"
Else
Cells(sor, oszlop) = "K"
Exit For
End If
Next
Next
'Keret
Range(Cells(1, 1), Cells(usor, uoszlop)).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 Sub
Új hozzászólás Aktív témák
- Samsung Galaxy S23 Ultra - non plus ultra
- Path of Exile (ARPG)
- Milyen videókártyát?
- Diablo IV
- Megkérdeztük az AI-t: milyen érzés, amikor megreguláznak?
- ZIDOO médialejátszók
- TCL LCD és LED TV-k
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
- BMW topik
- Dobozcserére kárhoztatja asztali csúcs-CPU-ját az Intel
- További aktív témák...
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- GYÖNYÖRŰ iPhone 13 Pro Max 128GB Gold -1 ÉV GARANCIA - Kártyafüggetlen, MS4368
- LG 49WQ95X-W - 49" NANO IPS - 5120x1440 Dual QHD - 144Hz - USB Type-C - HDR 400 - G-Sync - FreeSync
- OnePlus Nord CE3 Lite 128GB, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓ! Apple MacBook Pro 16 M4 Pro 48GB RAM 4TB SSD macbook garanciával hibátlan működéssel
- BESZÁMÍTÁS! ASUS A320M R3 1200 8GB DDR4 370GB SSD GTX 1050Ti 4GB Zalman T3 Plus DeepCool 400W
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Fferi50

