-
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
- sziku69: Fűzzük össze a szavakat :)
- OLED monitor topic
- Víz- gáz- és fűtésszerelés
- Tőzsde és gazdaság
- Garmin Venu 4 - a nagy ugrás
- Futás, futópályák
- Fejhallgató erősítő és DAC topik
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Wise (ex-TransferWise)
- Kerti grill és bográcsozó házilag (BBQ, tervek, ötletek, receptek)
- További aktív témák...
- Xbox / Microsoft Store feltöltőkártya kód (digitális, HU) több címlet, több db, azonnal, olcsón
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- AKCIÓ! HP EliteBook x360 830 G7 i5-10210U 16GB 512GB 1 év garancia
- Astro A50 4th Gen wireless + base station fejhallgató
- Powerbank Anker Prime, 20100mAh, 220W, QC + PD, Fekete A110BH11
- DELL LATITUDE 7330 /i5-1245U/16GB/256 GB SDD/13.3/FHD/IPS/Garancia/
- ÁRGARANCIA!Épített KomPhone i5 10400F 16/32/64GB RAM RX 7600 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50