Hirdetés
- Poco X8 Pro Max - nem kell ide sem bank, sem akkubank
- iOS alkalmazások
- Xiaomi 17 Ultra - jó az optikája
- Xiaomi 15T Pro - a téma nincs lezárva
- Fotók, videók mobillal
- One mobilszolgáltatások
- Fittyet hány a pesti napfényre a Honor 600
- Samsung Galaxy A57 - kecses test, lusta lélek
- Xiaomi 14 - párátlanul jó lehetne
- Apple iPhone 17 Pro Max – fennsík
-
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
-
whatnot
őstag
Nem próbáltam ki, de gyanúm szerint a következő miatt nem fog menni.
Van nekem ugye egy Ttime nevű, Date típusú változóm.
A 04/06/2013 09:00:00 stringet beledobom ebbe a változóba, szépen meg is eszi. Amikor lépésről lépésre nézem a kódot, a Locals Window-ban lehet nézni a változók aktuális értékeit. A fenti string pedig 2013.04.06 09:00:00 formátumban kerül be egyből a Ttime változóba, tehát a hiba már meg is történt. Azaz eleve rosszul értelmezi a napot, hónapot.Persze elvileg meg lehet csinálni regular expression-nel, de valami elegánsabb, kevésbé bonyolult megoldást keresek. No meg nem is csináltam még regex-et excelben.
-
whatnot
őstag
Sziasztok!
Makróban van dátum/időpont formázási problémám.
Adott formátumban, stringként van megadva az időpont:nn/hh/éééé óó:pp:mm
Ezt kéne alábbi formátumba rakni:
éééé.hh.nn óó:pp
Tehát pl. 25/04/2013 09:00:00 -> 2013.04.25 09:00
A fenti példát az alábbi kódom egyszerűen meg is oldja:
For i = 2 To LastRow
If Cells(i, 9).NumberFormat <> "yyyy.mm.dd hh:mm" Then
Ttime = Cells(i, 9).Value
Cells(i, 9).Value = Format(Ttime, "yyyy.mm.dd hh:mm")
End If
NextA probléma ott kezdődik, amikor a dátumban a hónap és a nap látszólag érvényesen felcserélhető lenne. Pl. ebben az esetben:
04/06/2013
Ebből ugyanis ez lesz: 2013.04.06, a 2013.06.04 helyett.Sajnos az nem segít, hogy én előre letisztázom neki, az adott cellákban a formátum nn/hh/éééé óó:pp:mm és ebből legyen szíves átalakítani.
Ötlet?
-
whatnot
őstag
Vagy írsz rá egy makrót
Ha az adatokat sorba lehet rendezni, akkor lehet készíteni egy ciklust, ami az első sortól az utolsó előttiig megvizsgálja, hogy az adott cella és a következő cella egyenlő-e. Ha nem, lépjen a következő sorba, ha igen, törölje mindkét cellát és lépjen le két sort. -
whatnot
őstag
Azt valaki nem tudja, hogy ha Cells-szel határozok meg egy Range-t egy másik workbookban, akkor azzal miért nem tudok műveleteket csinálni?
Pl.
Workbooks("Másik_workbook.xls").Sheets("Sheet1"). _
Range(Cells(1,1), Cells(5,1)).CopyEz nem működik.
Workbooks("Másik_workbook.xls").Sheets("Sheet1"). _
Cells(5,1).CopyÖnmagában viszont igen.
Az előbbi csak a Select-tel hajlandó működni, azaz:Workbooks("Másik_workbook.xls").Sheets("Sheet1"). _
Range(Cells(1,1), Cells(5,1)).Select
Selection.Copy -
whatnot
őstag
válasz
baderoli
#17319
üzenetére
Hát pedig az eredeti problémádra írtam egy makrót, rejtegetések nélkül.
Book2-be másol Book1-ból.
Adatok A1-től lefelé vannak, csak a cellákat másolja, nem sorokat.
Ha sorokat is kéne másolni, akkor nyilván azzal ki kell egészíteni.*Hm, az utolsó cellát még egyszer bemásolja lejjebb, megnézem, miért
Ok, megvan, egy felesleges ciklus volt.Sub Copy30()
Application.ScreenUpdating = False
Dim LastRow As Integer
Dim cycle As Integer
Dim i As Integer, j As Integer, k As Integer
LastRow = Workbooks("Book1").Sheets("Sheet1").Range("A1").End(xlDown).Row
cycle = LastRow \ 30
For i = 0 To cycle
j = i * 35 + 1
k = i * 30 + 1
If i <> cycle Then
Workbooks("Book1").Sheets("Sheet1").Activate
Range(Cells(k, 1), Cells(k + 29, 1)).Select
Selection.Copy
Workbooks("Book2").Sheets("Sheet1").Activate
Range(Cells(j, 1), Cells(j, 1)).Select
Selection.PasteSpecial
Else
Workbooks("Book1").Sheets("Sheet1").Activate
Range(Cells(k, 1), Cells(LastRow, 1)).Select
Selection.Copy
Workbooks("Book2").Sheets("Sheet1").Activate
Range(Cells(j, 1), Cells(j, 1)).Select
Selection.PasteSpecial
End If
Next
Range("A1").Activate
End Sub -
whatnot
őstag
válasz
motinka
#17263
üzenetére
Naptárprogramokban pl. be lehet. Én Reminderfox-ot használok, ott át lehet állítani.
Excelben az bonyolíthatja a dolgot, hogy a napra hivatkozás történhet függvénnyel is és lehet, nem megoldható, hogy a függvény számolásakor a beállításokat is nézegesse (bár csak egy objektum paraméterét kéne megnéznie).
Passz -
whatnot
őstag
válasz
Delila_1
#17231
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ShapeDel As Integer
Dim wPath As String
Range("A1").Select
If Target.Address = "$A$1" Then
For ShapeDel = 2 To ActiveSheet.Shapes.Count
Shapes(ShapeDel).Delete
Next
...Ezt beraktam egy teljesen új munkalapra.
Első próbánál még ott volt a nyíl, másodiknál már nem. -
whatnot
őstag
Következő furcsa problémám akadt.
A feladat a következő, event macro: A1 cella értékétől függően a workbook mappájából szúrjon be egy képet.
Ezt a megírt macro meg is csinálja.
A1 cellában data validation van, méghozzá droplisttel. Ezt is egyszerű beállítani.Azonban az első választást követően eltűnik a droplist. Maga a data validition még él, mert ha rossz értéket próbálok beírni, szól, hogy ilyen érték nem megengedett a data validation miatt. Viszont a droplist nem elérhető, nincs ott a nyíl a cella jobboldalán.
Ez mitől lehet?Itt a kód:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ShapeDel As Shape
Dim wPath As String
If Target.Address = "$A$1" Then
For Each ShapeDel In ActiveSheet.Shapes 'ez minden képet töröl a munkalapról!
ShapeDel.Delete
Next
Range("B2").Select
Select Case Range("A1").Value
Case "pic1"
wPath = ThisWorkbook.Path & "\pic1"
ActiveSheet.Pictures.Insert (wPath)
Case "pic2"
wPath = ThisWorkbook.Path & "\pic2"
ActiveSheet.Pictures.Insert (wPath)
Case "pic3"
wPath = ThisWorkbook.Path & "\pic3"
ActiveSheet.Pictures.Insert (wPath)
End Select
End If
End Sub
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Melyik tápegységet vegyem?
- Poco X8 Pro Max - nem kell ide sem bank, sem akkubank
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Lényegretörő Akasa hálókártya a 10 gigabitre vágyóknak
- OLED TV topic
- Kecskemét és környéke adok-veszek-beszélgetek
- Luck Dragon: Asszociációs játék. :)
- PayPal
- Ingatlanos topic!
- Tesla topik
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel! 13 hónap ultimate - 50.000 ft
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- 27% - ASUS ProArt GeForce RTX 4080 SUPER OC 16GB GDDR6X 256bit Videókártya !
- BESZÁMÍTÁS! GIGABYTE B650E R9 7900X 64GB DDR5 1TB SSD RTX 5080 16GB NZXT H9 Flow White Corsair 850W
- Samsung Gear VR: Note5, S6 (EDGE), S7 (EDGE)
- Eredeti Lenovo 300W töltők - ADL300SDC3A
- HIBÁTLAN iPhone 12 256GB Blue-1 ÉV GARANCIA - Kártyafüggetlen, MS4462
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest