-
Fototrend
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
Fferi50- LG L192WS monitor eladó: 19" 1440 900
- Samsung Galaxy A16 / 4/128GB / Kártyafüggetlen / 12Hó Ganacia / BONTATLAN NULL Perces!
- Felújított laptopok számlával, garanciával! Ingyen Foxpost!
- LG 27UL550-W - 27" IPS / 3840x2160 4K / 60Hz 5ms / HDR10 / AMD FreeSync
- ASUS TUF Dash F15 - 15.6"FHD 144Hz - i7-11370H - 16GB - 1,5TB SSD - RTX 3060 6GB - Win11
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest