Hirdetés
- sziku69: Szólánc.
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Graphics: Telefonvásárlási kálváriám....avagy clickbait cím: Horror a hardveraprón
- sziku69: Fűzzük össze a szavakat :)
- Gurulunk, WAZE?!
- Luck Dragon: Asszociációs játék. :)
- Szellem.: ATK Blazing Sky X1 V2 Extreme 2.0. Tényleg 2.0-a!
- Ketogén étrend
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- gerner1
-
LOGOUT
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
veterán
válasz
greenface
#22910
üzenetére
Mint kiderült, nem is volt jó a kód. Az Exceledben a bővítményeknél jelöld be a két, Analyzis kezdetűt, hogy a VB szerkesztő megismerje az egyes utasításokat.
Sub Erteket_Beilleszt()
Dim FN As String
Const utvonal = "C:\Adatok\Alkönyvtár\"
Application.DisplayAlerts = False
ChDir utvonal
FN = Dir(utvonal & "*.xlsx", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=utvonal & FN
Muvelet FN
ActiveWorkbook.Save
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.DisplayAlerts = True
End SubEzt kell indítanod, az egyes fájlok behívása után elindítja a Muvelet makrót, ami az értékek beillesztését végzi.
Sub Muvelet(FN)
Dim cella As Range
For Each cella In Sheets("material").Range("A5, A7, D10, A12, A14, B14, D14, A16, B16, C16, A18, B18")
cella = cella.Value
Next
For Each cella In Sheets("layout-volume").Range("A5, D5, A8, A10, C10, A12, C14")
cella = cella.Value
Next
Sheets("Munka1").Delete
End Sub -
Delila_1
veterán
válasz
greenface
#22902
üzenetére
2007-től működik, alatta az FN = Dir(utvonal & "*.xlsx", vbNormal) sorban az xlsx helyett írj xls-t.
A Const utvonal = "C:\Adatok\Alkönyvtár\" sorba a saját útvonaladat vidd be.
Az indító fájlodban Alt+F11-re bejön a VB szerkesztő. Bal oldalon kiválasztva a füzetedet Insert menü, Module. Jobb oldalon kapsz egy üres lapot, oda kell bemásolnod a lenti makrót.
A füzetből az Alt+F8-ra megejelő ablakban kiválasztod, és futtatod a makrót.
A füzetet makróbarátként kell mentened (2007-estől felfelé, alatta sima mentés kell).Sub Erteket_Beilleszt()
Dim FN As String
Const utvonal = "C:\Adatok\Alkönyvtár\"
Application.DisplayAlerts = False
ChDir utvonal
FN = Dir(utvonal & "*.xlsx", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=utvonal & FN
Sheets("material").Range("A5, A7, D10, A12, A14, B14, D14, A16, B16, C16, A18, B18") = _
Range("A5, A7, D10, A12, A14, B14, D14, A16, B16, C16, A18, B18").Value
Sheets("layout-volume").Range("A5, D5, A8, A10, C10, A12, C14") = _
Range("A5, D5, A8, A10, C10, A12, C14").Value
Sheets("Munka1").Delete
ActiveWorkbook.Save
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.DisplayAlerts = True
End Sub -
Fferi50
Topikgazda
válasz
greenface
#22901
üzenetére
Szia!
Miután az activeworkbook munkalapjain megy végig, a makrónak az adott munkafüzet egy moduljában kellene lenni.
Viszont megoldható az is, hogy egy külön munkafüzetbe teszed, akkor viszont ki kell egészíteni egy olyan résszel, ami megnyitja egyenként a fájlokat, utána ezzel a makróval elvégzi a módosítást, majd visszazárja/elmenti a fájlokat.Ha emlékeim nem csalnak, volt már itt ilyenről szó. (fájlok listázása mappából).
Ha mégsem találnád, írj és segítek.
Üdv.
-
-
Fferi50
Topikgazda
válasz
greenface
#22869
üzenetére
Szia!
Próbáld ki a következőt:
Sub kepletszun()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
if sh.name<>"törölni kell" then
sh.UsedRange.Value = sh.UsedRange.Value
endif
Next
application.displayalerts=false
sheets("törölni kell").delete
application.displayalerts=true
End SubHa csak képletek és értékek vannak, akkor menni fog. Ha kimutatás is van a munkalapokon, akkor viszont a kimutatásnál hibával leáll. (Természetesen lehet a hibát kezelni, de most csak gyorsan ezt dobtam fel, ha szükséges, szívesen átírom arra is.)
Üdv.
-
-
honfoglalo
senior tag
válasz
greenface
#19685
üzenetére
Sub lathatocellak()
Dim lArea As LongWith Sheet1.AutoFilter.Range.Columns(1)
For lArea = 1 To .Areas.Count
.Areas(lArea).FormulaR1C1 = "=peldastring"
Next lArea
End With
End SubAhol a columns()-ba pedig az adott oszlop száma kerüljön. A mezőnevet írd vissza manuálisan, a peldastring helyére kerüljön a képlet.
-
lappy
őstag
válasz
greenface
#14417
üzenetére
Szia!
Példa:
Ha a cellában ez van
A1 2012.06.07 23:59:59 ---- formázás dátumra
A1-ben a következőt látod 2012.06.07 de ha rámész a cellára akkor még ott van a óó:pp:mp
Beszúrsz egy oszlopot az adataid mellé
Ezután B1-be a következő képletet írod =A1
Nálam (2007-ben) a B1 cellában a következőt látom 2012.06.07 ami dátum formátumú
és ahhoz hogy dolgozni tudj vele kijelölöd a B oszlopot és másolás -- irányított beillesztés-- érték!
ha nem megy akkor vhova töltsd fel és átalakítva megkapod! -
lappy
őstag
válasz
greenface
#14406
üzenetére
Szia!
Gondolom sok adatod lehet éé:hh:nn óó:pp:mp formátumú amit sikerült formázással dátum formátumra varázsolni! És ebből kell neked csak a dátum rész!
Akkor segédtáblát kellene létrehozni! A képlet pedig A1 cella esetén =A1 ezután pedig kijelölöd mindet és másolás majd irányított beillesztés csak érték és formázod dátumra és kész!
Új hozzászólás Aktív témák
Hirdetés
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel! 13 hónap ultimate - 50.000 ft
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Lenovo ThinkStation P330 Gen 2 Tower i7 / Xeon workstation /számla- garancia
- Apple iPhone 17 Pro 512GB & 1TB Bontatlan Független Összes Szín / 27% áfás ár
- Új/Újszerű Apple Macbook Air 15,3" M4 /24GB/1TB - Ezüst - MAGYAR - 15 Ciklus - 2,5 év garancia
- iPhone 15 Pro Max 256GB 100% (1év Garancia)- ÚJ EREDETI AKKUMULÁTOR - AKCIÓ
- BESZÁMÍTÁS! Asus Z690 i5 13600K 32GB DDR4 1TB SSD RX 6800 XT 16GB Aerocool P500B Digi ARGB 850W
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50