Hirdetés
- iPhone topik
- Így spórolhat az Apple az iPhone 18 kijelzőin
- Xiaomi 13 - felnőni nehéz
- Külföldi prepaid SIM-ek itthon
- Fittyet hány a pesti napfényre a Honor 600
- Samsung Galaxy S26 - szeret, nem szeret
- MIUI / HyperOS topik
- Fotók, videók mobillal
- Huawei Watch GT 6 és GT 6 Pro duplateszt
- Kisebb lett a Honor MagicPad3 Pro
-
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
-
#8746
Fire/SOUL/CD
félisten
iwu
#8745
-
#8671
m.zmrzlina
senior tag
iwu
#8670
m.zmrzlina
senior tag
Az én megoldásomban a
Columns("A:B").EntireColumn.AutoFit
helyett ezt:
With Columns("A:B")
.Select
.EntireColumn.AutoFit
.HorizontalAlignment = xlLeft
End Withbetenni.
Ja és a
activerow = Range("A" & sorsz + 1, "I" & sorsz + 1).Value
sort törölni. Nem létező változónak ad értéket majd nem használja semmire.
Mire észrevettem, hogy benne maradt már nem volt szerkeszthető a hsz. -
#8668
m.zmrzlina
senior tag
iwu
#8661
m.zmrzlina
senior tag
Nekem ezt sikerült kiötleni:
Sub valogat()
Dim sorsz As Integer
Dim holavege As Integer
Sheets("Munka1").Select
Cells(Rows.Count, 1).End(xlUp).Select
holavege = ActiveCell.Row
For sorsz = 1 To holavege - 1
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(sorsz + 1).Name = Sheets(1).Cells(sorsz + 1, 1).Value
Sheets("Munka1").Select
Range("A1:I1").Select
Selection.Copy
Sheets(1 + sorsz).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Munka1").Select
Range("A" & sorsz + 1, "I" & sorsz + 1).Select
activerow = Range("A" & sorsz + 1, "I" & sorsz + 1).Value
Selection.Copy
Sheets(1 + sorsz).Select
Cells(1, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Columns("A:B").EntireColumn.AutoFit
Next sorsz
Sheets("Munka1").Delete
ActiveWorkbook.SaveAs "C:\Documents and Settings\agb\Dokumentumok\masneven.xlsm"
End SubAbból a munkafüzetből indul ahol a kiindulási lista van, elkészíti a munkalapokat igény szerint, majd törli az eredeti lista munkalapját és menti a munkafüzetet más néven.
Nem egy minden részletében kimunkált végleges megoldás inkább csak gondolatébresztő, de működik.Érdekelnének a szakértő vélemények.
-
Delila_1
veterán
Régen leveleztünk, biztos a régi címemmel próbálkoztál. Inkább beírom ide a kódot. A füzetet, amiben most 1 lapon vannak az adatok, Eredeti.xls-nek neveztem el, az újat, amit a makró hoz létre, UjFuzet.xls névvel illettem.
Az útvonalat az első sorban írd át.Sub SokLap()
Const utvonal As String = "F:\Eadat\"
Dim lapsz As Integer, lap As Integer
Dim lapnev As String
lapsz = Range("A" & Rows.Count).End(xlUp).Row
Application.SheetsInNewWorkbook = lapsz - 1
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=utvonal & "UjFuzet.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("Eredeti.xls").Activate
For lap = 2 To lapsz
lapnev = Cells(lap, 1)
Workbooks("UjFuzet.xls").Sheets(lap - 1).Name = lapnev
Rows(1).EntireRow.Copy Workbooks("UjFuzet.xls").Sheets(lapnev).Rows(1)
Rows(lap).EntireRow.Copy Workbooks("UjFuzet.xls").Sheets(lapnev).Rows(2)
Next
Windows("UjFuzet.xls").Activate
For lap = 1 To lapsz - 1
Sheets(lap).Select
Range("A1:I2").Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Next
Application.SheetsInNewWorkbook = 3
End Sub -
-
-
Delila_1
veterán
Jelöld ki a táblát, vagy annak azt a részét, ahol be akarod tömni a lyukakat.
Szerkesztés/Ugrás/Irányított ugrás/Üres cellák
Beírod-> =
nyomsz egy fel nyilat
Ctrl+Enter
Ez egyszerre az összes kijelölt celládba beviszi a fölötte lévő adatot hivatkozással. Ha fixen akarod (nem képlettel) látni ezután a most bevitt értékeket, ezután kijelölöd újra az összes adatot, Ctrl+C, Irányított beillesztés/Értéket. -
#2888
DoubleLayer
csendes tag
iwu
#2887
DoubleLayer
csendes tag
Lehet, hogy nem volt egyértelmű az első leírásom, bocs.
Tehát egy cellában a teljes cím szerepel, mittudomén mondjuk: "1111 Budapest, Váci út 25." - a példáknál maradva, ez lenne a D12 cella.
Lehet, hogy ki kell vennem előre, külön cellába az irányítószámokat... Csak az megint egy csomó plusz munka lenne visszafelé... -
-
Gh0sT
addikt
Darabtelivel nemtom megcsinálni.
De itt egy másik módszer:
Az oszlopod mellé beszúrsz egy másik oszlopot a következő képlettel:
=HA(A1>10;HA(A1<20;1;0);0)
Ez 1 értéket ad, ha teljesül a feltétel, 0-t, ha nem. Aztán kell valahova egy szumma, és már meg is vagy. A képletet tartalmazó oszlopot pedig elrejted, hogy szép legyen.
Szerk.: de szar, nemtok semmi elegáns megoldást, de még próbálkozom.
[Szerkesztve]
VBScript?
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Steam, GOG, Epic Store, Humble Store, Xbox PC Game Pass, Origin Access, uPlay+, Apple Arcade felhasználók barátságos izgulós topikja
- World of Tanks - MMO
- Horgász topik
- Milyen autót vegyek?
- Mibe tegyem a megtakarításaimat?
- iPhone topik
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Kerékpárosok, bringások ide!
- PlayStation 5
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- További aktív témák...
- AKCIÓ! 10TB WD Purple Pro SATA HDD meghajtó garanciával hibátlan működéssel
- Infinix Zero 5G / 8/128GB / Kártyafüggetlen / 12Hó Garancia
- GAMER PC! Intel Ultra 7 265 / RTX 5070 / 32GB 6000MHz / 1TB Gen4 / 750w Gold!
- ÚRIS10!!! RAMÁRON! LEGION 5 i7-13650HX 16GB RAM 512GB SSD RTX 5070 8GB
- AKCIÓ! 2TB Kingston Fury Renegade NVMe SSD meghajtó garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest