-
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
-
Delila_1
veterán
válasz
Morphy
#52270
üzenetére
Próbáld így:
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Address = "$G$1" Then kereses Target.ValueEnd SubSub kereses(keres)If keres = "" ThenActiveSheet.ListObjects("adatbazis").Range.AutoFilter Field:=41ElseActiveSheet.ListObjects("adatbazis").Range.AutoFilter Field:=41, Criteria1:=keresEnd IfEnd Sub -
Delila_1
veterán
válasz
Morphy
#44598
üzenetére
Ahogy FFeri is írta, elég gyalázatos az Excel dátum-kezelése.
Próbáld meg, hogy szélesre veszed az oszlopot, akkor a dátumok jobbra igazítva jelennek meg, az esetleges szövegként megadottak balra.Összeállítottam egy ilyen vegyes (A) oszlopot, majd egy (B) segédoszlopban felszoroztam 1-gyel minden tagját. Érdekes módon a szövegeseket is számmá alakította a szorzás, és a B oszlop dátumkénti formázása valódi dátumot csinált mindegyikből. A szűrés is megfelelően működött.
-
Fferi50
Topikgazda
válasz
Morphy
#44596
üzenetére
Szia!
Sajnos a dátumok kezelése ezen a területen borzasztó az Excelben. Esetleg egy részletet, mondjuk csak addig az oszlopig, amiben a dátum van, fel tudnád tenni valahová. Természetesen az érzékeny adatok nélkül és elég lenne kb. 50 sor is.
Tennék még egy próbát a helyedben: Átmásolnám az adatokat és megnézném, hogy az új helyen mi történik.
Nekem ezzel a formával, amit mutattam, működik.
Üdv. -
Fferi50
Topikgazda
válasz
Morphy
#44241
üzenetére
Szia!
A PrintArea szöveges változót vár, azaz a nyomtatási terület címét. Tehát a változód neve, mondjuk nyomtter, akkornyomtter="$A$1:$B$", illetve ha egy cellába teszed (ez legyen az X1), akkor a cella értéke legyen$A$1:$B$2.
EzutánWorksheets("final").PageSetup.PrintArea=Worksheets("info").Range("X1").Value
vagy:Worksheets("final").PageSetup.PrintArea=nyomtter
Persze a nyomtter változód a feltételnek megfelelően kell beállítanod.
Ebben az esetben nem kell külön cellába kiírni a címet.
Üdv. -
Morphy
csendes tag
válasz
Morphy
#44233
üzenetére
Na, az első részt és a mentési részt sikerült megoldanom. Már csak egy maradt:
Ha az info lapon az A1-be kerül adat, akkor a nyomtatási terület legyen a final lapon A1:B2
Ha az info lapon az A2-be kerül adat, akkor a final lapon A3:B4
Ha az info lapon az A3-ba kerül adat, akkor a final lapon A5:B6
....Egy külön cellába kihozom, hogy melyik területet nyomtassa, de a makrónál a .PageSetup.printArea -t nem tudom paraméterezni a váltózóval, mert béna vagyok.
Tudna valaki erre megoldást?
-
Delila_1
veterán
válasz
Morphy
#30698
üzenetére
A laphoz rendeld:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ide As Long
If Target.Address = "$A$1" Then
ide = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(2).Range("A" & ide) = Target
End If
End SubHa még üres a második lap A oszlopa, A2-től kezdve írja be egymás alá az első lap A1-be bevitt adatait.
-
Delila_1
veterán
válasz
Morphy
#30217
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim abra, utvonal As String, kiterj As String
If Target.Address = "$A$1" Then
utvonal = "D:\Képek\" '*****
kiterj = ".jpg" '*****
abra = utvonal & Application.WorksheetFunction.VLookup(Target, Range("I:J"), 2, 0) & kiterj '*****
On Error Resume Next
ActiveSheet.Pictures("Kép").Delete
ActiveSheet.Pictures.Insert(abra).Name = "Kép"
ActiveSheet.Pictures("Kép").Select
With Selection
.Left = Columns(2).Left
.Top = Rows(3).Top
.Width = 70 '*****
.Height = 65
End With
Range("A1").Select '*****
End If
End Sub -
Fferi50
Topikgazda
válasz
Morphy
#30215
üzenetére
Szia!
Azt jelenti, hogy az A1 cellához nem fűztél megjegyzést. Delila előző hozzászólása tartalmazza, hogy fűzz megjegyzést a cellához. Ezt meg kell tenned "kézzel" - továbbá a megjegyzés szöveg kitörlését is - , mielőtt a makró elindulna.
De ki is egészíthető a makró a következő sorral:Target.AddComment Text:=""
Ezt a kep= sor után kell beírni.Üdv.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Morphy
#30211
üzenetére
Az A1 cellába tettem az érvényestést, az I oszlopban vannak a terméknevek, mellettük a hozzájuk tartozó képek nevei.

Az A1 cellához fűzz megjegyzést, töröld ki belőle a szöveget.
A makrót a lapodhoz rendeld (a téma összefoglaló szerint). Írd át a két, csillagokkal jelzett sorban az útvonalat, és a képek kiterjesztését – ha szükséges.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kep, utvonal As String, kiterj As String
utvonal = "D:\Képek\" '*****
kiterj = ".jpg" '*****
If Target.Address = "$A$1" Then
kep = utvonal & Application.WorksheetFunction.VLookup(Target, Range("I:J"), 2, 0) & kiterj
Target.Comment.Shape.Fill.UserPicture kep
End If
End Sub
Új hozzászólás Aktív témák
- Teljes verziós játékok letöltése ingyen
- EAFC 26
- Androidos fejegységek
- Honor Magic8 Pro - bevált recept kölcsönvett hozzávalókkal
- Katasztrofális PC-piacra figyelmeztet az IDC
- PlayStation 5
- Kerékpárosok, bringások ide!
- Borderlands 4
- One mobilszolgáltatások
- Allegro vélemények - tapasztalatok
- További aktív témák...
- Xbox / Microsoft Store feltöltőkártya kód (digitális, HU) több címlet, több db, azonnal, olcsón
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- AKCIÓ! Apple MacBook Pro 16 M1 Max 32GB RAM 1TB SSD notebook garanciával hibátlan működéssel
- ASUS Vivobook 15 - 15.6"FHD IPS - i5-1335U - 8GB - 512GB - Win11 - 1+ év garancia - MAGYAR
- HP EliteBook 855 G7 15,6" Ryzen 5 PRO 4650U, 16GB RAM, 256GB SSD, jó akku, számla, 6 hó gar
- Legion 5 GAMING Notebook! 16" OLED / RTX 5070 / Ultra 9 275HX / 32GB DDR5 / 1TB NVMe! BeszámítOK
- Samsung Galaxy S25 Ultra 5G 12/256GB Titanium Black használt, szép állapot 6 hónap garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest


Fferi50