-
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
válasz Fferi50 #31032 üzenetére
Igen, ez egy másik felfogása a feladatnak. Megírtam ezt is. A futási idők különbsége csak sok sor esetén mérhető, én mindössze 20 sorral dolgoztam.
Nem tudjuk, hány oszlop van az Eredeti lapon. A makróban az A:K tartományt vettem alapul, amit két helyen kell módosítani, a csillagokkal jelzett sorokban.
Szerk.: az A:K tartományra történő hivatkozást is át lehetne állítani a makróban, de azt már nem írom meg.
Sub Kulcsok()
Dim usor As Long, usor1 As Long, lap As String, sor As Long, lapnev
With Sheets("Eredeti")
.Range("AA:AN").ClearContents
.Range("AA1") = .Range("C1")
.Range("AB1") = .Range("AA1")
.Range("A1:K1").Copy .Range("AD1") '*****
usor = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & usor).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AA1"), Unique:=True
usor1 = .Range("AA" & Rows.Count).End(xlUp).Row
For sor = 2 To usor1
.Cells(2, "AB") = .Cells(sor, "AA")
'*****
.Range("A1:K" & usor).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("AB1:AB2"), _
CopyToRange:=.Range("AD1:AN1"), Unique:=False
lap = .Range("AB2") & ""
On Error Resume Next
Set lapnev = Sheets(lap)
If Err.Number <> 0 Then
Sheets.Add Before:=Sheets(Sheets.Count)
ActiveSheet.Name = lap
On Error GoTo 0
Else
Sheets(lap).Cells.ClearContents
End If
.Range("AD1").CurrentRegion.Copy Sheets(lap).Range("A1")
Next
End With
Beep
MsgBox "Kész van.", vbInformation
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- btz: Internet fejlesztés országosan!
- PlayStation 5
- Star Trek Online -=MMORPG=-
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- alza 404 akciók
- Milyen egeret válasszak?
- Alapértelmezett konfiguráción sok Core CPU-nak lehet stabilitási gondja
- Házimozi belépő szinten
- Spyra: akkus, nagynyomású, automata vízipuska
- nVidia tulajok OFF topikja
- 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