-
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
-
Delila_1
veterán
válasz
m.zmrzlina
#30401
üzenetére
Egyszer mégis előfordulhatott, hogy range nevet adtál egy változónak.
![;]](//cdn.rios.hu/dl/s/v1.gif)
-
Delila_1
veterán
válasz
m.zmrzlina
#30392
üzenetére
Változóként soha ne adj olyan nevet, ami VBA kulcsszó (for, with, range, on, else, string, not, do, loop ...).
A kulcsszavakat a VBE – ha az eredeti színbeállításodat tartottad meg – sötétkéken jeleníti meg. -
Delila_1
veterán
válasz
EmberXY
#30395
üzenetére
Eddig észre sem vettem ezt a státuszsori kiírást.
Különböző adatok lekérdezése a Munka1 lapra:
Sub adatok()
With Munka1.Range("A1")
.Offset(0, 0).Value = Environ("username") 'F felhasználó neve
.Offset(1, 0).Value = Environ("computername") 'PC neve
.Offset(2, 0).Value = Environ("userdomain") 'felh. domain
.Offset(3, 0).Value = Environ("sessionname") 'berendezés
.Offset(4, 0).Value = Environ("PROCESSOR_ARCHITECTURE") 'proci tip.
.Offset(5, 0).Value = Environ("PROCESSOR_IDENTIFIER") 'proci azonosító
.Offset(6, 0).Value = Environ("NUMBER_OF_PROCESSORS") 'procik száma
End With
End Sub -
Delila_1
veterán
válasz
Sweetraver
#30372
üzenetére
Próbálom kitalálni, mit is szeretnél. Ha a főnök nevét akarod beíratni a C oszlopba, akkor a C2 képlete
=INDEX(A:B;HOL.VAN(D2;A:A;0);2)
Ezt másolhatod lefelé.
-
Delila_1
veterán
válasz
m.zmrzlina
#30378
üzenetére
A címet adja vissza, mégpedig $ jelekkel együtt, fixen.
-
Delila_1
veterán
válasz
Sweetraver
#30372
üzenetére
Egyik mondatoddal felülírod a másikat.
"a D oszlop adatait alapból kézzel írom be"
"alapból megvan az A, B és a D"
" Azt szeretném látni a D1-es cellában, hogy =a2"Ha a D-be kézzel viszed be az adatot, akkor minek a képlet? Ha képlet van, minek a kézi bevitel?
Sehogy sem értem, mit akarsz csinálni, de a sort megadja a HOL.VAN függvény. Az oszlop betűjele pedig
=karakter(oszlop()+65) -
Delila_1
veterán
válasz
m.zmrzlina
#30373
üzenetére
Sub valogat()
Dim int_usor As Integer, int_uoszlop As Integer, int_vege As Integer
Dim cella As Range, tartomany As String
int_usor = 135: int_uoszlop = 50: int_vege = 2
tartomany = Range(Cells(2, 3), Cells(int_usor, int_uoszlop)).Address
For Each cella In Sheets(1).Range(tartomany)
If cella.Interior.ColorIndex = 6 And cella.Value <> "" And Application.WorksheetFunction.CountIf(Worksheets("csatorna").Range("D2:D50"), cella.Value) = 0 Then
Worksheets("csatorna").Cells(int_vege, 4).Value = cella.Value
int_vege = int_vege + 1
End If
Next
End SubA tartomany változó string legyen, ne range. Nézd meg a for each sort is.
A Dim sorokat érdemes mindig a makró elejére tenni egy kupacba, akkor egy hosszabb makróban könnyű megtalálni. Betettem a cella változót is oda, azt nem dimenzionáltad.
-
Delila_1
veterán
válasz
Sweetraver
#30367
üzenetére
A D2 cella képlete =HAHIBA(INDEX(A:B;HOL.VAN(C2;B:B;0);1);"nincs"), ezt másold le a többibe alá.
EmberXY, mntn: szívesen.

-
-
Delila_1
veterán
A két képletben a B ill. az A elé tegyél $ jelet.
Mivel 2007 előtti verziójú Excelt használsz, nem tudod megadni a tartományt, de az A oszlop formátumát át tudod másolni a többi oszlopodra, pl. a formátumfestő ecset segítségével. Vagy másolod az A oszlopot, kijelölöd a többi oszlopot, jobb klikk, irányított beillesztés, formátum.
-
Delila_1
veterán
válasz
m.zmrzlina
#30352
üzenetére
Most egy kicsit rendesebben írom be a két makrót. Tegnap siettem, és eléggé el nem ítélhető módon nem dekraláltam a változókat, ráadásul az idézett makrókat nem jelöltem programkódként. Bocsi.
Sub Adatok()
Dim Balfelső As String
Balfelső = "$B$2": Végrehajtás Balfelső
Balfelső = "$C$9": Végrehajtás Balfelső
End Sub
Sub Végrehajtás(Balfelső)
Dim sorok As Long, oszlopok As Long, Jobbalsó As String, cella As Range, osszeg
Dim ws_Kabelo As Worksheet
Set ws_Kabelo = Sheets("Kabelo")
sorok = 5: oszlopok = 4: osszeg = 0
Jobbalsó = ws_Kabelo.Range(Balfelső).Offset(sorok - 1, oszlopok - 1).Address
For Each cella In ws_Kabelo.Range(Balfelső & ":" & Jobbalsó)
osszeg = osszeg + cella
Next
ws_Kabelo.Range(Jobbalsó).Offset(1) = osszeg
End SubAz osszeg változónál nem adtam meg a típust. Közel sem biztos, hogy összegezni akarsz a ciklusban, és ha mégis, nem tudom, hogy egész-, vagy lebegőpontos értékeid vannak-e.
-
Delila_1
veterán
Sub adatok()
Balfelső = "$B$2": Végrehajtás Balfelső
Balfelső = "$C$9": Végrehajtás Balfelső
End SubEz hívja meg a Végrehajtás makrót, átadva a kezdő cella címét
Sub Végrehajtás(Balfelső)
sorok = 5: oszlopok = 4: osszeg = 0
jobbalsó = Range(Balfelső).Offset(sorok - 1, oszlopok - 1).Address
For Each cella In Range(Balfelső & ":" & jobbalsó)
osszeg = osszeg + cella
Next
Range(jobbalsó).Offset(1) = osszeg
End SubA jobb alsó cella alá kiírattam a tartományok összegét.
-
Delila_1
veterán
kezdet = "$C$9"
Set terület = Range(kezdet).Offset(0, 0, sor - 1, oszlop - 1)Így próbáltam, de nem fogadja el. Munkalapon ez a C9-től a sor-1, oszlop-1 tartományra vonatkozik.
Ott az =ofszet(C9,0,0,sor-1,oszlop-1) a terület.
Például a =SZUM(OFSZET(B2;0;0;3;2)) képlet összegzi a B2:C3 tartományt. -
Delila_1
veterán
válasz
m.zmrzlina
#30344
üzenetére
Próbálkoztam az offset-tel, de az nem jött össze, pedig elegánsabb lett volna.
-
Delila_1
veterán
válasz
m.zmrzlina
#30341
üzenetére
Például
kezdsor = 9: kezdoszlop = 3
sorok = 5: oszlopok = 4
Set terület = Range(Cells(kezdsor, kezdoszlop), Cells(kezdsor + sorok - 1, kezdoszlop + oszlopok - 1))
For Each cella In ws_Kabelo.területC9 a bal felső cella, a vizsgálandó terület 5 sor és 4 oszlop.
-
Delila_1
veterán
válasz
Fferi50
#30316
üzenetére
Szia!
Megkaptam a füzetet.
A fapados (képletekkel bevitt) eredmények jók, a kimutatással viszont eltérések vannak. A valahonnan letöltött adatokkal van némi gubanc, amit a kimutatás érzékel, a képletek simán veszik az akadályt. A kimutatáshoz először makróval kellene rendet vágni az adatok között.Mindenképp jó, hogy összeállítottad, eddig nem vettem észre az "Eltérés" opciót, és ez másoknak is hasznos lehet. Köszönöm.
-
Delila_1
veterán
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Stanlee
#30250
üzenetére
Az adatok a Munka1-, a leválogatás a Munka2 lapon van.
A Munka1 I oszlopában az ÓRA függvény adja a B oszlop óraszámát.
A Munka2 A oszlopában az órák szerepelnek 0-tól 24-ig.A Munka2 lap B2 képlete
=HAHIBA(INDEX(Munka1!$A:$I;HOL.VAN($A2;Munka1!$I:$I;1);OSZLOP()+1)-INDEX(Munka1!$A:$I;HOL.VAN($A2;Munka1!$I:$I;0);OSZLOP()+1);"")
ezt másold jobbra és le.
-
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 -
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 -
Delila_1
veterán
válasz
Szicskeee
#30112
üzenetére
Valószínű, hogy az MSCOMT2. ocx nincs meg a gépeden, a C:\Windows\System(32 vagy 64) könyvtárban.
Le tudod tölteni, majd a mappába másolás után a következő lépéseket kell végrehajtanod.Alt+F11.gyel belépsz a VB szerkesztőbe.
Tools menü, References. A fájltípusnál beállítod az ocx kiterjesztést. A Browse gombra kattintva kitallózod a most bemásolt fájlt, OK.Lehet, hogy újra kell indítanod az Excelt.
-
Delila_1
veterán
válasz
Szicskeee
#30103
üzenetére
A füzet megnyitásával indul a beviteli userform, de az első lapon lévő gombbal is újra indíthatod.
A dátum mező az aktuális dátumot mutatja, amit módosíthatsz.
Kilépés: a városnál az üreset jelöld ki, a Felvitel gomb bezárja a formot.Nem tettem bele semmi ellenőrzést (pl. nem tudom, mi jön az AB mezőbe, lehet, hogy csak számokat kellene elfogadnia. Azt sem ellenőriztettem, hogy minden mező ki van-e töltve).
-
Delila_1
veterán
válasz
Ricardo128
#30070
üzenetére
Sub MappaLista()
Dim utvonal As String, sor As Long, FN As String
Sheets("Munka1").Select 'Erre a lapra másoljon *****
Columns(1) = ""
utvonal = "C:\Főmappa\AlMappa\AlAlMappa\" 'Ebből a könyvtárból *****
ChDir utvonal
sor = 1
FN = Dir(utvonal)
Do While FN <> ""
Cells(sor, 1) = FN
sor = sor + 1
FN = Dir()
Loop
End SubEz a makró a "C:\Főmappa\AlMappa\AlAlMappa\" mappából bemásolja a fájlok címét kiterjesztéssel a Munka1 lap A oszlopába. Csillagokkal jelöltem, amit át kell írnod a saját értékeidre (útvonal, lap neve).
-
Delila_1
veterán
válasz
Sweetraver
#30059
üzenetére
Itt van hozzá a makró. Amelyik cella változik, oda betesz egy megjegyzést az új értékkel és a hozzá tartozó dátummal. A már meglévő megjegyzést folytatja az új változás értékével. A legelső értéket nem menti.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 16 Then
On Error Resume Next
Range(Target.Address).AddComment
Range(Target.Address).Comment.Visible = True
Range(Target.Address).Comment.Text Text:=Range(Target.Address).Comment.Text & vbLf & Target & " " & Format(Date, "yy.mm.dd")
Range(Target.Address).Comment.Visible = False
End If
End Sub -
Delila_1
veterán
-
Delila_1
veterán
válasz
Reinhardt
#30035
üzenetére
Most is kipróbálhatod, ahogy én is tettem.
Felveszel egy mappát, ennek az útvonalát teszed be az utvonal változóba.
Teszel néhány képet bele, amiket elnevezel 001.jpg-től 015.jpg.ig
A lapon a sorokat olyan magasságúra állítod, amilyen magasak legyenek a képek.
Indítod a makrót.Szombaton a For sor=1 to 15 sorban a 15 helyett annyit írsz, ahány képed van.
-
Delila_1
veterán
válasz
szabonagyur
#30030
üzenetére
Igazad van, jó lenne.

Nézd meg az előbbi hsz-emet, módosítottam.
-
Delila_1
veterán
válasz
szabonagyur
#30026
üzenetére
Van egy olyan szabály, hogy ha az év első hetében 4 napnál kevesebb van (mint az idén), akkor a hét száma a valóságos második héten lesz 1. Az első valóságos hét 53 lesz.
Az A1-ben kezdődnek a dátumok 2016.01.01-gyel. A B1 képlete:
=HA(ÉS(HÉT.NAPJA(DÁTUM(ÉV(A1);1;1);2)>3;WEEKNUM(A1;2)-1=0);53;WEEKNUM(A1;2)-1)
-
Delila_1
veterán
válasz
Reinhardt
#30024
üzenetére
Feltételezem, hogy címsorod van, ezért a képeket a második sortól kezdve szúrom be. Ellenkező esetben a +1-eket töröld a makróból három helyen.
A képek magasságát a sorok magasságához igazítom, a képarányok megtartásával.A makróban 2 sort jelöltem csillagokkal. Az elsőnél a képek elérési útvonalát kell módosítanod, a másodiknál a kiterjesztést, ha nem jpg.
Sub Kepek()
Dim sor As Long, kepneve As String
Dim utvonal As String
utvonal = "D:\Képek\" '1.*******
For sor = 1 To 15
kepneve = Right("000" & sor, 3) & ".jpg" '2.*******
Range("A" & sor + 1).Select
ActiveSheet.Pictures.Insert(utvonal & kepneve).Select
Selection.ShapeRange.Top = Rows(sor + 1).Top
Selection.ShapeRange.Left = 0
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = Rows(sor + 1).Height
Next
End Sub -
Delila_1
veterán
A rendezett lapon kell futtatnod a makrót.
A makró elején a B és az AD oszlop adataiból törlöm a felesleges, ismétlődő adatokat, hogy tisztább legyen a kép, majd az AD oszlopban – vesszővel elválasztva – gyűjtöm kategóriákat.
A Sheets("Munka1").Select sorban a Munka1 helyére a saját lapod nevét írd be.Sub Tisztitas()
Dim sor As Long, usor As Long
'Előkészítés
Sheets("Munka1").Select 'Ide a saját lapod nevét írd be
usor = Range("A" & Rows.Count).End(xlUp).Row
Range("AJ2:AJ" & usor).FormulaR1C1 = "=LEFT(RC[-34],SEARCH("")"",RC[-34]))"
Range("AJ2:AJ" & usor).Copy
Range("B2").PasteSpecial xlPasteValues
Range("AJ2:AJ" & usor) = ""
With Columns("AD:AD")
.Replace What:="Transpak alkatrészek>>", Replacement:=""
.Replace What:=">>", Replacement:=""
End With
'Sortörlés
For sor = usor To 2 Step -1
If Cells(sor, "K") = Cells(sor - 1, "K") Then
Cells(sor - 1, "AD") = Cells(sor - 1, "AD") & "," & Cells(sor, "AD")
Rows(sor).Delete Shift:=xlUp
End If
Next
End Sub -
Delila_1
veterán
válasz
lizakattila
#29963
üzenetére
Range(Target.Address).Offset(0, -14) = Now()
-
Delila_1
veterán
válasz
poffsoft
#29953
üzenetére
Rendben.
Sub dolgozik()
' Billentyűparancs: Ctrl+d
ActiveCell = "dolgozik"
ActiveCell.Offset(1,0).Select
End SubAz Offset függvény, mint a magyar neve (eltolás) is mutatja, az aktív helytől – vagy a megjelölttől, pl. range("B5").offset(...,...) – való eltolást mutatja. Ha mindkét paraméter 0, akkor helyben topogunk, gyakorlatilag 0 az eltolás.

-
Delila_1
veterán
válasz
Pilács
#29940
üzenetére
Feltételezem, hogy az "egyik oszlop" a C, ez az oszlop tartalmaz címsort, és hogy a képek és az útvonaluk folyamatosan követik egymást, üres sorok nélkül.
A makró a bemásolt képek magasságát a sorok magasságához igazítja, és a méretarányt az eredetihez képest megtartja.
Sub kepek()
Dim sor As Long, usor As Long
usor = Range("C" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
Range("D" & sor).Select
ActiveSheet.Pictures.Insert(Range("C" & sor)).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = Rows(sor).Height
Next
Columns(3).Delete Shift:=xlToLeft
End Sub -
Delila_1
veterán
válasz
firemanus82
#29923
üzenetére
Az Fferiétől kicsit eltérő megoldást javaslok – nem mintha az övével valami baj lenne, csak minden feladatnak számtalan megoldása lehetséges.
Mivel elég körülményes a leírás, inkább csatolom a füzetet.
2 makró van benne, az elsőt a ThisWorkbook laphoz rendeltem. Ez másolja az eredeti neveket az M oszlopba a K-ból a füzet megnyitásakor. Az M2:Makárhány tartománynak a Nevek nevet adtam. Ez a forrása a beviteli celláknak.
A másik makrót a Munka1 laphoz rendeltem. Mikor valamelyik érvényesítésben (B2, C2, D2) kiválasztasz egy nevet, az M oszlopban lévők közül törli azt.
Ha újra az összes nevet akarod látni az M oszlopban, a ThisWorkbook laphoz rendelt makrót kell indítanod, vagy egyszerűen átmásolod a neveket K2-től az M2-be.
-
Delila_1
veterán
válasz
huliganboy
#29911
üzenetére
Nem tudom, a C oszlopban meghagyandó adat szöveges, vagy szám típusú, ezért mindkettőre rákérdezek.
A makró
Sub Kigyomlal()
Dim sor As Long, usor As Long, marad, eddig As Long
marad = InputBox("Melyik adat maradjon meg a C oszlopban?")
Application.ScreenUpdating = False
usor = Range("C" & Rows.Count).End(xlUp).Row
For sor = usor To 2 Step -1
eddig = Range("C" & Rows.Count).End(xlUp).Row
If Cells(sor, "C") = marad Or Cells(sor, "C") = marad * 1 Then GoTo Tovabb
If Application.WorksheetFunction.CountIf(Range("C2:C" & eddig), Cells(sor, "C")) > 1 Then _
Rows(sor).Delete Shift:=xlUp
Tovabb:
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
Szicskeee
#29893
üzenetére
Az Excel módot ad a cellák összevonására, de többnyire nem tudja úgy kezelni, ahogy a felhasználó szeretné, hibák jönnek létre. Ha csak lehet, kerüljük el az összevonásokat.
Javaslom, hogy szüntesd meg az összevonásokat az A-B-C és F oszlopokban, majd írd be a szükséges értékeket az üres cellákba.
Ez egyszerűen megoldható. Kijelölöd a 4 oszlopot addig a sorig, ameddig a D oszlopban vannak adataid.
Ctrl+g-re bejön az ugrás menü, ahol az Irányítottat, majd az Üres cellákat választod. Marad a kijelölés, az aktuális cellába beírsz egy egyenlőség jelet, majd FEL nyilat nyomsz, Ctrl+Enter. Ezzel az összes, eddig üres cellában megjelenik a fölötte lévő érték, hivatkozással.A hivatkozások helyére érdemes beilleszteni az értéküket. A 4 teljes oszlopodat kijelölve, másolva, irányítottan rájuk illeszted az értékeket.
Ha zavar, hogy minden sorban látod a bevitt értékeket, feltételes formázással láthatatlanná teheted.
=A3=A2 -> a karakter színét a háttérével megegyezőre állítod.Az egész művelet fél perc alatt megvan, sokkal több idő leírni.

Vízszintesen is elkerülhető az összevonás, amit címsorokban szokás alkalmazni. Például az A1:D1 cellák közepén szeretnénk elhelyezni egy címet. Beírjuk az A1-be a szöveget, kijelöljük az A1:D1 tartományt. Cellaformázás, Igazítás fül, a Vízszintesen legördülőben A kijelölés közepére paramétert állítjuk be.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#29883
üzenetére
Azok nem szerepelnek benne, 0 a szorzatuk.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#29871
üzenetére

Sztanozs: Fire
-
Delila_1
veterán
válasz
batmanéhes
#29865
üzenetére
Szerintem nem volt világos a cél. 06- nélkül kevesebbet kell gépelni (sok számról van szó), és kisebb méretű a tartomány is. A már begépelt számokat is 1 kijelöléssel, formátum átírással egyszerre lehet módosítani, nem kell az összefűző képlet, a másolás, az érték beillesztése, majd a képletet tartalmazó oszlop törlése.
Új hozzászólás Aktív témák
- Xiaomi 15 - kicsi telefon nagy energiával
- Forza sorozat (Horizon/Motorsport)
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Rezsicsökkentés, spórolás (fűtés, szigetelés, stb.)
- Apple MacBook
- Fotók, videók mobillal
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Elektromos (hálózati és akkus) kéziszerszámok, tapasztalatok/vásárlás
- Apple asztali gépek
- Formula-1
- További aktív témák...
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- 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!
- Xbox / Microsoft Store feltöltőkártya kód (digitális, HU) több címlet, több db, azonnal, olcsón
- Apple iPhone 12 Pro / 128GB / Kártyafüggetlen / 12Hó Garancia
- OnePlus Nord CE3 Lite 128GB, Kártyafüggetlen, 1 Év Garanciával
- Új HP 16 Victus FHD IPS 144Hz Ryzen7 8845HS 5.1Ghz 16GB 1TB SSD Nvidia RTX 4060 8GB Win11 Garancia
- Apple Watch Series 10 42mm Jet Black 96% (1év Garancia)
- ÁRGARANCIA!Épített KomPhone Ryzen 5 4500 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest


![;]](http://cdn.rios.hu/dl/s/v1.gif)




