-
Fototrend
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
rubint
#22945
üzenetére
Úgy látom, 2003-asnál magasabb verziót használsz. Ha nem, akkor a Rendezes makrót át kell alakítanod.
Az első makróban a Range("C3:K17") rész helyére írd a valós területet.Sub A_oszlopba()
Dim ertek As Range
For Each ertek In Range("C3:K17")
If ertek > "" And Not IsNumeric(ertek) Then
Range("A" & Application.WorksheetFunction.CountA(Columns(1)) + 1) = ertek
End If
Next
Rendezes
End Sub
Sub Rendezes()
Dim usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Add Key:=Range("A2:A" & usor) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Munka1").Sort
.SetRange Range("A1:A" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub -
Fferi50
Topikgazda
válasz
rubint
#22945
üzenetére
Szia!
Nem írtad, milyen excel verziót használsz. De mindegyikben működik a következő:
-összemásolod az összes oszlop adatát egy oszlopba egymás alá.
-adatok - speciális szűrő/irányított szűrő - egyedi értékek - máshova másol.
- az eredményt rendezed és a számokat, egyéb jeleket tartalmazó cellákat törlöd.Ez még kézzel sem hosszú, annyi cellára sem, amennyit írtál.
Ha automatizálni szeretnéd, akkor egyszer makró rögzítés, majd a megfelelő részeket átírod.Üdv.
Új hozzászólás Aktív témák
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Xiaomi Redmi Note 12 128GB, Kártyafüggetlen, 1 Év Garanciával
- BESZÁMÍTÁS! GIGABYTE A520M R5 5500 16GB DDR4 512GB SSD GTX 1070 8GB Zalman T3 Plus DeepCool 400W
- GYÖNYÖRŰ iPhone 12 Pro 128GB Silver -1 ÉV GARANCIA - Kártyafüggetlen, MS4380, 100% Akksi
- MacBook Pro 14 2024 M4, 32 GB RAM, 1 TB SSD 27% Áfás
- í kilenc! AKCIÓS PRECÍZIÓS KÉSZÜLÉK! 7560 i9-11950H 32GB RAM 1TB SSD Nvidia RTX A3000 6GB 1 év gar
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
