-
GAMEPOD.hu
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
Egy segédoszlopban összefűzöd az egyes cellákat valami elválasztó karakterrel (szóköz, alsó kötőjel), olyan sorrendben, ahogy a rendezést szeretnéd látni. A kép szerint az első az idő, második vagy a gép, vagy a TervAzon. A mutatott adatok szerint bármelyik lehet. Akárhány oszlopod adatait is összefűzheted, majd eszerint rendezd a teljes tartományt.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Fferi50
őstag
-
Fferi50
őstag
Szia!
Az alábbi makró az Excel sajátos eszközeivel próbálja megoldani a problémát (több segédtartományra is szüksége van, amit az elején definiálok).
Sub rendezi()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, sora As Integer, sor As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set rng1 = Range("A1").CurrentRegion
Set rng2 = Range("AA1")
Set rng3 = Range("Q1:Q2"): rng3.Cells(1).Value = "Gép"
Set rng4 = Range("U1")
rng1.Copy Destination:=rng2
Set rng2 = rng2.CurrentRegion
rng1.Offset(1, 0).ClearContents
sor = 2
Do
rng1.Cells(sor, 2).Value = Application.Small(rng2.Columns(2).Offset(1, 0), 1)
sora = Application.Match(rng1.Cells(sor, 2), rng2.Columns(2), 0)
rng3.Cells(2, 1).Value = rng2.Cells(sora, 1).Value
rng2.AdvancedFilter Action:=xlFilterCopy, criteriarange:=rng3.Columns(1), copytorange:=rng4, unique:=False
rng4.Sort key1:=rng4.Cells(1, 2), order1:=xlAscending, Header:=xlYes
rng4.Cells(1, 1).CurrentRegion.Offset(1, 0).Copy Destination:=rng1.Cells(sor, 1)
sor = rng1.End(xlDown).Row + 1
rng2.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=rng3.Columns(1), unique:=False
rng2.SpecialCells(xlCellTypeVisible).ClearContents
rng1.Rows(1).Copy rng2.Rows(1)
rng2.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=rng3.Cells(1), unique:=False
rng4.CurrentRegion.ClearContents
If Application.CountA(rng2) = 4 Then Exit Do
Loop
rng3.CurrentRegion.ClearContents
rng2.CurrentRegion.ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MsgBox "Kész van", vbInformation
End SubÜdv.
Új hozzászólás Aktív témák
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Rendszergazda topic
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Nvidia GPU-k jövője - amit tudni vélünk
- Marvel Snap
- bb0t: Gyilkos szénhidrátok, avagy hogyan fogytam önsanyargatás nélkül 16 kg-ot
- Befellegzett a HI-FI Rush és a Redfall fejlesztőinek
- Spórolós topik
- Van itt pár kép a Sony Xperia 1 VI-ról is
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- További aktív témák...
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen