Hirdetés
- Milyen okostelefont vegyek?
- Samsung Galaxy A54 - türelemjáték
- Google Pixel topik
- Poco X6 Pro - ötös alá
- Samsung Galaxy S24 FE - később
- Apple iPhone 16 - ígéretek földje
- OneSport OT07 - szevasztok, hollandok!
- Szívós, szép és kitartó az új OnePlus óra
- iPhone topik
- Samsung Galaxy S25 - végre van kicsi!
-
Mobilarena
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
-
Pakliman
tag
Egy lehetséges megoldás:
Sub Makró1()
Dim us As Long 'utolsó sor
Dim sor As Long
Dim osz As Long
Dim odb As Long 'figyelendő oszlopok száma
Dim nüdb As Long 'nem üres cellák a sorban
Dim ü As Long 'hány oszlopra van a következő nem üres cella
Dim t
t = Timer
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'21121 sor
'soronként átlag 1,4 db üres cella
'Proci: Ryzen 5 2600
'16GB RAM
'Futási idő: 9,84 másodperc
us = Columns("L").Rows(Cells.Rows.Count).End(xlUp).Row
odb = Range(Columns("L"), Columns("Q")).Columns.Count
For sor = 1 To us
nüdb = Application.CountIf(Range(Cells(sor, "L"), Cells(sor, "Q")), "<>")
If nüdb < odb Then
For osz = Columns("L").Column + 1 To Columns("Q").Column - 1
If IsEmpty(Cells(sor, osz)) Then
If Application.CountIf(Range(Cells(sor, osz + 1), Cells(sor, "Q")), "<>") > 0 Then
'Ha van egyáltalán még átpakolható adat...
'Ezen vizsgálat nélkül 12,2 másodpercig fut a 9,84 helyett!!
ü = 1
Do While IsEmpty(Cells(sor, osz + ü)) And (osz + ü <= Columns("Q").Column - 1)
ü = ü + 1
Loop
Cells(sor, osz) = Cells(sor, osz + ü)
Cells(sor, osz + ü).ClearContents
Else
Exit For
End If
End If
Next osz
End If
Next sor
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Debug.Print Round(Timer - t, 2)
End SubA futás ideje nagymértékben függ az üres cellák számától
Új hozzászólás Aktív témák
- Vèdelem az áramszünet ellen!
- Xiaomi Redmi 9 64GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
- Lenovo ThinkStation P520 Workstation! W-2145, 64GB, 512 SSD /Quadro - Számla, garancia
- DELL PowerEdge R640 rack szerver - 2xGold 6150 (18c/36t, 2.7/3.7GHz), 512GB RAM,10G, H740p 8GB, áfás
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest