Hirdetés
- Multimédiás / PC-s hangfalszettek (2.0, 2.1, 5.1)
- Hobby elektronika
- Gaming notebook topik
- Nem indul és mi a baja a gépemnek topik
- Modding és elektronikai kérdések
- Milyen házat vegyek?
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- Vezetékes FEJhallgatók
- Beelőzte az iparágat a HBM4 tömeggyártásával a Samsung
- Épített vízhűtés (nem kompakt) topic
-
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
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
- Xiaomi 13 Pro 12/256GB Ceramic Black használt 6 hónap garancia
- Bomba ár! Dynabook Portege X30-F - i5-8265U I 8GB I 256SSD I 13,3" FHD I Cam I W11 I Garancia!
- BESZÁMÍTÁS! Részletfizetés 0% THM ÚJ GIGABYTE A16 3VH 16" notebook R7 260 16GB RTX 5060 3 év 27%
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 32/64GB RAM RTX 5070Ti 16GB GAMER PC termékbeszámítással
- GYÖNYÖRŰ iPhone 14 Pro 128GB Space Black -1 ÉV GARANCIA - Kártyafüggetlen, MS4322
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
