- AMD vs. INTEL vs. NVIDIA
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Apple asztali gépek
- Gaming notebook topik
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
- HP notebook topic
- Milyen processzort vegyek?
- Bluetooth hangszórók
- OLED TV topic
Új hozzászólás Aktív témák
-
Delila_1
veterán
A RowSource tulajdonságnál megadod a lista tartományát, a címsor nélkül, pl.
Munka1!A2:B15, ahol az első a címsor.
Beállítod az oszlopok számát a ColumnCount-nál. Az egyes oszlopok szélességét a ColumnWidths tulajdonsághoz írd be pont mértékegységben, pontosvesszőkkel elválasztva az adatokat.
Ha címsort is akarsz látni, akkor A1-től add meg a tartományt, és a ColumnHeads legyen True. -
Delila_1
veterán
válasz
Zalanius
#3067
üzenetére
Szerkesztés: elnézést, Vertusnak szól,
Nálam a makrót tartalmazó füzet első lapján, az A oszlopban vannak a fájlnevek, kiterjesztéssel. Mellettük a B-ben a hozzájuk tartozó jelszavak.
Két helyen kell a makrót személyre szabnod. Az első az utvonal változó, a második a Match függvényes sor. Mindkettő végére tettem 3 db *-ot.Private Sub Megnyit()
Dim FN As String, sor As Variant, jelszo
Const utvonal As String = "F:\Eadat\Próba\" '***
ChDir utvonal
FN = Dir(utvonal & "*.xlsx")
Do While FN <> ""
On Error Resume Next
sor = Application.Match(FN, Sheets(1).Columns(1), 0) '***
If sor = vbError Then
On Error GoTo 0
Else
jelszo = Sheets(1).Cells(sor, 2)
Workbooks.Open Filename:=utvonal & FN, Password:=jelszo
'*******************************************************
'másolás
'*******************************************************
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
FN = Dir()
Loop
End Sub -
Delila_1
veterán
Az R kiinduló cellához képest a sor eltolását mutatja, a C pedig az oszlopét. Az eltolás mértéke a szögletes zárójelek közé írt érték. Ha nincs az R és/vagy a C után zárójeles érték, akkor a kiinduló cellával azonos sorról/oszlopról van szó. Ha zárójelek nélkül szerepel egy szám az R, ill. C mögött, az fix hivatkozást jelent.
R[-3]C[5] az aktív (vagy hivatkozott) cella fölötti 3. sor, és a tőle jobbra lévő 5. oszlop celláját jelöli.
RC[2] aktív cella sorában, tőle 2 oszloppal jobbra lévő cella.
A
Range("G" & sor) = "=sum(RC1:RC5)"összegzi a sor A:F celláinak az értékét. -
Delila_1
veterán
Magyar függvények angol megfelelőjét így tudhatod meg:
Beírod a lapra a függvényt – persze úgy, hogy működjön is, helyes hivatkozásokkal.
Lapfülön jobb klikk, Beszúrás, Nemzetközi makrólap. Az új lapra átmásolod az előbbi függvényt, a hivatkozott cellákkal együtt. Megkapod az angol elnevezést. -
Delila_1
veterán
válasz
smallmer
#3005
üzenetére
Vidd be az utvonal állandóba a saját útvonaladat, a *****-os sorban meg add meg a sablon fájlod-, és a benne lévő makró nevét.
Mivel sok fájlról van szó, hogy ne unatkozz közben, a státuszsorban kiírja 10 darabonként a másolások számát.Sub osszemasolo()
Dim FN As String, i As Integer
Dim FD, utvonal As String
Const utvonal = "D:\Főmappa\almappa\" 'jöhet a megnyitás, másolás"
ChDir utvonal
FN = Dir("*.xlsx")
Do While FN <> ""
i = i + 1
Workbooks.Open Filename:=FN, ReadOnly:=True
MsgBox "Itt másolgatunk", vbInformation
'A már kész makrót itt hívhatod meg: workbook("sablon_fájl.xltx").makró_neve *****
Workbooks(FN).Close False
FN = Dir()
If i Mod 10 = 0 Then Application.StatusBar = "Másolva: " & i & "db fájl!"
Loop
Application.StatusBar = False
MsgBox "Befejeződött az összemásolás", vbInformation, "Fájlok összemásolása"
ActiveWorkbook.Save
' ActiveWorkbook.Close
End Sub -
Delila_1
veterán
A tegnapi makró egyszerűsítve úgy, hogy az összes cella háttér színezést szüntesse meg, mielőtt a kijelölt sorokat besárgítja:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim kezd As Long, ucso As Long, cim As String
Application.EnableEvents = False
Cells.Interior.Color = xlNone
cim = Target.Address
kezd = Selection.Row
ucso = Range(cim).Row + Range(cim).Rows.Count - 1
Rows(kezd & ":" & ucso).Interior.Color = vbYellow
Application.EnableEvents = True
End Sub -
Delila_1
veterán
Már majdnem kész volt a makró, mikor jött a szerelő.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim elozo As String, kezd As Long, ucso As Long, b As Integer, cim As String
Application.EnableEvents = False
cim = Target.Address
Debug.Print Target.Address
If Range("AA1") <> "" Then
elozo = Range("AA1") & ":" & Range("AB1")
Range(elozo).Interior.Color = xlNone
End If
kezd = Selection.Row
For b = Len(cim) To 1 Step -1
If Mid(cim, b, 1) = "$" Then
ucso = Mid(cim, b + 1, 20) * 1
Exit For
End If
Next
Rows(kezd & ":" & ucso).Interior.Color = vbYellow
Range("AA1") = kezd: Range("AB1") = ucso
Application.EnableEvents = True
End SubItt a kijelölés alsó sorát egy ciklussal kerestetem ki. Ha sikerül elegánsabb megoldást találni rá, megírom.
-
-
Delila_1
veterán
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim elozo As String
Range(Target.Address).Interior.Color = vbYellow
If Range("AA1") <> "" Then
elozo = Range("AA1").Value
Range(elozo).Interior.Color = xlNone
End If
Range("AA1") = Target.Address
End SubSzínezi a kiválasztott területet, majd az AA1-be beírja a jelenlegi területet. A következő kijelölésnél a színezésen kívül az AA1-ben tárolt cím (terület) színezését megszünteti.
-
Delila_1
veterán
Lapfülön jobb klikk, Kód megjelenítése.
Ezzel beléptél a Visual Basik-be, ott is a lapod kódjához. A jobb oldalon lévő nagy üres felületre viheted be az eseményvezérelt makrót. Az üres rész tetején balra a (General) helyett kiválasztod a Worksheet opciót.
Már meg is jelent a makród kezdő- és befejező sora.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End SubEz a makró akkor indul, ha egy cellát kiválasztasz, magyarul, ha rálépsz. A két sor közé írhatod meg a kódodat, pl.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Interior.Color = vbYellow
End SubA kiválasztott cella háttere sárga lesz.
Adhatsz feltételt, hogy pl. csak az A oszlopban sárgítson.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Target.Interior.Color = vbYellow
End If
End SubEzernyi más dolgot is rendelhetsz a makróhoz.
-
Delila_1
veterán
Valahol elvész a változó értéke. Lépésenként futtatva megtalálod az eltűnés helyét. Valószínűleg nem publikusként deklaráltad a változó(ka)t, vagy a 2. makró meghívásánál elmulasztottad a változó(k) átadását.
Ha "Konkrétan az mindig "A" lesz.", akkor miért teszed változóba, mikor fixen is megadhatnád, és nem foglalnád vele a memóriában a helyet?
-
Delila_1
veterán
A különbség az, hogy a szintaktika szerint & jelet kell alkalmazni, a + jel értelmetlen.
Csináld a következőt: írj be egy üres cellába egy egyest. Másold Ctrl+c-vel. Jelöld ki a dátumokat tartalmazó cellákat, majd Irányított beillesztés, értéket, a művelet pedig szorzás. Mindegyik dátumos tartományodra végezd el, akkor biztosan egyforma típusúak lesznek az adatok.
-
-
Delila_1
veterán
válasz
prodrakan
#2914
üzenetére
A makrót írd át.
Sub Parosit()
Dim usor As Long, sor As Long, utvonal As String
Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook
Dim WF As WorksheetFunction, TalalSor As Long
Dim kezd As Long, vegez As Long
Set WB1 = Workbooks("Excel1.xlsm")
Set WF = Application.WorksheetFunction
utvonal = "F:\Eadat\Excel fórumok\PH\"
kezd = Application.InputBox("Add meg a kezdő hét sorszámát", "Kezdő hét", , , , , , 1)
vegez = Application.InputBox("Add meg a záró hét sorszámát", "Záró hét", , , , , , 1)
kezd = WF.Match(kezd, Columns(2), 0)
vegez = WF.Match(vegez, Columns(2), 1)
Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False
usor = WB1.Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
'Excel2-ből I oszlop az Excel1 G-be
Workbooks.Open Filename:=utvonal & "Excel2.xlsx"
Set WB2 = Workbooks("Excel2.xlsx")
WB1.Activate
For sor = kezd To vegez
If Cells(sor, "G") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "G") = WB2.Sheets("Munka1").Cells(TalalSor, "I")
End If
If Cells(sor, "J") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "J") = WB2.Sheets("Munka1").Cells(TalalSor, "J")
End If
Next
WB2.Close False
'Excel3-ból I oszlop az Excel1 K-ba
Workbooks.Open Filename:=utvonal & "Excel3.xlsx"
Set WB3 = Workbooks("Excel3.xlsx")
WB1.Activate
For sor = kezd To vegez
If Cells(sor, "K") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Munka1").Columns(1), 0)
Cells(sor, "K") = WB3.Sheets("Munka1").Cells(TalalSor, "I")
End If
Next
WB3.Close False
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
prodrakan
#2912
üzenetére
Annál a módszernél, amit írtál (első üres sortól kezdje bemásolni a másik 2 fájlból az adatokat), túl sok a hibalehetőség. Most megírtam úgy, hogy az első adattól, a 4. sortól fusson végig egy For-Next ciklussal addig a sorig, ahol az A oszlopban megtalálja az utolsó adatot.
Az útvonal értékét a makró 10. sorában kell átírni, és esetlegesen új értéket adni neki a 36. sor előtt.
-
Delila_1
veterán
válasz
prodrakan
#2906
üzenetére
Beírtam a makróba, hogy amíg dolgozik, a státuszsorban megjelenik a "Nyugi, dolgozom" szöveg. Kevés adatnál nem látszik, olyan gyorsan eltűnik.
Pontosítanod kellene, melyik oszlopot akarod még figyeltetni, mit figyeljen a makró, és mit tegyen.
Sub Kikeres()
Dim UresSor As Long, WSInnen As Worksheet, WSIde As Worksheet
Dim TalalSor, usor As Long, WF As WorksheetFunction
Set WSInnen = Workbooks("Excel2.xlsx").Sheets("Munka1")
Set WSIde = Workbooks("Excel1.xlsm").Sheets("Munka1")
Set WF = Application.WorksheetFunction
WSIde.Activate
Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False
usor = Range("G" & Rows.Count).End(xlUp).Row
Do
UresSor = Range("G" & usor).End(xlUp).Row - 1
If UresSor < 3 Then
Application.StatusBar = False
Application.ScreenUpdating = True
Exit Sub
End If
If Cells(UresSor, "A") <> "" Then
On Error Resume Next
TalalSor = WF.Match(Cells(UresSor, "A"), WSInnen.Columns(1), 0)
Cells(UresSor, "G") = WSInnen.Cells(TalalSor, "I")
On Error GoTo 0
Else: usor = UresSor - 1
End If
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "G") = ""
End Sub -
-
Delila_1
veterán
válasz
prodrakan
#2900
üzenetére
Próbáld ezzel:
Sub IndexFuggveny()
Dim UresSor As Long
UresSor = Range("K1").End(xlDown).Row + 1
Do
If Cells(UresSor, "A") = "" Then UresSor = UresSor + 1
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "K") = ""
Range("C" & UresSor & ":C5000") = "=INDEX('\\Hubudr99102dat\mf\MF3\" _
& "FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$I$" & UresSor & ":$I$5000;HOL.VAN(A" & UresSor & "," _
& "'\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$A$" & UresSor & ":$A$5000,0))"
End SubA Range("K1").End(xlDown).Row a K1 cellán nyomott Ctrl+le művelet VBA-s megfelelője. Ez az első, üres cella fölötti sor értékét adja meg. 1-et hozzáadva megkapjuk az első üres cella sorát a K oszlopban.
Ha ez a sor az A oszlopban üres, addig növeljük a sorszámot, míg igaz nem lesz, hogy a K üres, az A nem.
Ide, ill. innen az ötezredik sorba írjuk be (nálam a C oszlopba, te majd átírod) a hosszú képletedet, egy lépésben. -
Delila_1
veterán
válasz
alexy92
#2861
üzenetére
A bemásolt tengeri kígyóban ilyen részletek vannak:
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=FalseSelect utasítások nélkül
usor = Range("C1").End(xlDown).Row
Range("C2:C" & usor).Copy
With Workbooks("invoices_masterfile.xlsm").Sheets("main")
usor = .Range("H" & Rows.Count).End(xlUp).Row + 1
.Range("H" & usor).PasteSpecial Paste:=xlPasteValues
End WithLátod, az usor változót felhasználtam a másoláshoz. Az adatok már ott csücsülnek a vágólapon, a másik füzet egyik lapján új értéket rendelhetek hozzá, jelen esetben a H oszlop első üres sorának a számát.
A Select utasítások ráállnak az adott füzet adott lapjára, ott is bizonyos cellá(k)ra. Ez időveszteség, ráadásul ugrál a kép.Végül
If Err.Number <> 0 Then
sub3
Else
On Error GoTo 0
sub2
End If -
Delila_1
veterán
válasz
alexy92
#2816
üzenetére
A Module1-ben találod a makrókat.
Írd meg a 9 rutint, ahol aRange("C" & sor) = Range("A" & sor) / Range("B" & sor)sor helyére beírod a saját feladatodat. Az
If Err.Number <> 0 Then RutinC Else RutinBsor helyén a saját rutinjaid nevét add meg! Minden rutinban különböző feladatokat adhatsz meg az én makróim osztása helyett.
-
Delila_1
veterán
válasz
Petya25
#2778
üzenetére
A képeken láthatod, hogy az adatokat tartománnyá alakítottam, majd az A2:B10-nek nevet adtam. Ez lett a ComBobox RowSource bemenő tartománya (Munka1!ID_Nev)
A ComboBox ColumnCount értéke 2, ezért látszik mindkét oszlop. Az egyik nevet (Anna) szándékosan 2 ID-hez rendeltem.
A név kiválasztásakor a lenti makró beviszi a kívánt értékeket a 2 labelbe.
Private Sub ComboBox1_Change()
Dim sor As Integer
With Sheets(1)
sor = Application.Match(ComboBox1, .Columns(1), 0)
Varos = .Cells(sor, 3)
Fogl = .Cells(sor, 4)
End With
End Sub
Azt még most sem értem, miért egy diagramról akarsz értékeket bevinni a formra, miért nem abból a tartományból, amiből létrehoztad a diagramot.
-
Delila_1
veterán
válasz
Petya25
#2776
üzenetére
1. A grafikonos kérdést nem értem.
2. Teszel a formra egy textboxot, ahol megadod a rekord sorszámát. Mivel az itt megadott érték szöveg típusú (ezért hívják textboxnak), át kell alakítanod számmá – pl. hozzáadsz 0-t, vagy szorzod 1-gyel. Ezután már beírhatod a form objektumaiba a cells(sorszám, oszlop) értékeket.
-
#2770
Delila_1
veterán
BigBadPlaYeR
#2769
Delila_1
veterán
válasz
BigBadPlaYeR
#2769
üzenetére
A helyfoglalásokat (Dim) a ciklus elé írd, és csak a nevük és típusuk szerepeljen ott.
Dim ConfigName As String, PartNo As String, Description As StringA ciklusban már csak értéket adj ezeknek:
ConfigName = myConfigsList.Item(i)
PartNo = swActiveModel.CustomInfo2(myConfigsList.Item(i), "PartNo")stb.
-
#2767
Delila_1
veterán
csaszizoltan
#2766
Delila_1
veterán
válasz
csaszizoltan
#2766
üzenetére
Dim sor As Variant
sor = Application.Match("keresett_érték", Columns(1), 0)
If VarType(sor) = vbError Then
MsgBox "Nem szerepel az A oszlopban a keresett érték", vbCritical, "Hiba"
On Error GoTo 0
Exit Sub
End IfFontos, hogy a változót, aminek az Application.Match függvénnyel akarsz értéket adni, Variant típusúként deklaráld.
-
Delila_1
veterán
Elég ennyi:
With Selection
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin 'körbe
.Borders(xlInsideVertical).Weight = xlThin 'belső függőleges
End WihtA stílust és a színt nem kell külön megadni, mert így az alapértékek lesznek érvényesek (xlContinuous és xlAutomatic)
-
Delila_1
veterán
Mutatok egy másik módszert.
Kijelölöd a tartományt, Képletek | Definiált nevek | Kijelölésből új, Felső sorból és Bal oszlopból bejelölve. Ez létrehozza a sorok és oszlopok tartományát a megfelelő nevekkel.
A létrehozás után érdemes megnézni a Névkezelő-ben, milyen nevek jöttek létre.
Ezután már csak a szóköz, más néven metszet operátort kell alkalmazni, ahol a sor és oszlop nevét egy szóköz köti össze, mint a képen a B10 cellában.
Arra kell ügyelni, hogy a címek nem tartalmazhatnak szóközt (Nagy Anna), és nem kezdődhetnek számmal.
Az első esetben a Kijelölésből új menüpont a szóköz helyére alsó kötjelet tesz, Ebben az esetben a B10 képlete: =Nagy_Anna február.
Számmal kezdődő címsoroknál is alsó kötjel kerül a név elejére.1. hét -> _1._hét
-
Delila_1
veterán
El lehet kerülni a cellák összevonását, mert bár megengedi az Excel, sokszor váratlan hibákat okoz.
Az A1:A3 összevonása helyett ezt tedd:
• Beírod az A1-be a címet,
• Kijelölöd az A1:A3 tartományt,
• Cellaformázás, igazítás fül,
• A szöveg igazítása vízszintesen legördülőből "A kijelölés közepére" opciót válaszd ki.Látszólag középre kerül a cím, és itt a látszat az, ami számít. Ha szegélyeket alkalmazol, azok is megfelelnek majd a kívánt kinézetnek.
Szerk.: a teljes tartományban megszünteted az összevonásokat, majd végrehajtod az első szöveg középre helyezését. Ezután már csak ki kell jelölnöd a következőt, az F4 gyorsbillentyű ezt is középre teszi. Az F4 az utolsó műveletet ismétli. Kijelölsz - F4, kijelölsz - F4.
-
Delila_1
veterán
Összeállítottam, de nem sok értelmét látom.
Ha pl. 3 táblázatod van kitöltve, és a G2-be 5-öt írsz, akkor csak adatok nélküli táblázatot hoz be az A2-es kiválasztásnál.Még azt teheted meg ezzel az új felállással, hogy nem sorban állítod ki a táblázatokat, hanem pl. a 3-as után jön a hatodik.
-
Delila_1
veterán
Örülök, hogy tetszik.
A-tól G-ig nem lehet rejteni, csak teljes sorokat.
A feltételeidnél átfedések vannak. A 2 is kisebb, mint 6.Jobb lett volna így a meghatározás:
<2 (ez negatív szám, vagy 0 és 1,9999 közötti érték)
>=2 és <3 (ez 2-től 2,9999 közötti érték)
... és így tovább.Egyébként nem kell hozzá makró, autoszűrővel szín szerinti szűrést is végre tudsz hajtani.
-
Delila_1
veterán
Azért leírom, de szigorúan próba nélkül. A laphoz kell rendelni a makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sor As Long
If Target.Address = "$B$1" And IsNumeric(Target) Then
Application.EnableEvents = False
Columns(1).ClearContents
For sor = 1 To Target
Cells(sor, 1) = "Teszt " & sor
Next
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
A sor = Application.Match(Range("A2"), .Columns(1), 0) a sor változóba beteszi azt az értéket, ahol a Match (hol.van) függvény a Rejtett lapon az első oszlopban megtalálja az A2 cella értékét .
A Range("B2:D4" & sor).Copy .Range("B" & sor) másolja a B2
4 tartományt a Rejtett lapnak abba a sorába, ott is a B oszlopba, amit a Match megtalált. Jó. hogy írtad, az & sor-t vedd ki. Helyesen:
Range("B2:D4").Copy .Range("B")A Táblák nevet a Képletek | Névkezelő menüpontban láthatod. Ha rákattintasz, a Hivatkozás mezőben látod, melyik területre vonatkozik. Ezt a területet módosítja a Nevadas makró. A
sor = Sheets("Rejtett").Range("B" & Rows.Count).End(xlUp).Row
megkeresi az utolsó sort a Rejtett lapon, a sor számát eltárolja a sor változóban.
Az ActiveWorkbook.Names("Táblák").Delete törli az előző, Táblák című nevet. A következő sor megadja az új Táblák név területét. Ez a Rejtett lap H (nyolcadik) oszlopának első sorától addig tart, mint a sor/3+1 érték.
Például a Rejtett lapon az utolsó kitöltött sor a 18. 18/3=6. Ilyenkor a Táblák nevű terület a H1:H7 tartomány lesz. Ha 3 táblád van kitöltve, akkor a sor=9, 9/3+1=4, a területe Táblák H1:H4 lesz. A Sheets4 lap A2 cellájában lévő érvényesítés mindig az aktuális Táblák-at mutatja. Nézd meg az érvényesítésben a Forrást!Azt hiszem, a gombokat kicsit alacsonyra vettem, nem férnek ki a szövegek. Így kellene kinézniük:
-
Delila_1
veterán
Nem látszanak a képeken a sor- és oszlopazonosítók, így csak találgatni lehet, mi melyik cellában van. A makrót arra az esetre írtam, ha a képeken láthatóak az A1 cellában kezdődnek.
A két tábla képleteiben fixáld az oszlopokat $ jellel. Pl. =B3-D3 helyére =$B3-$D3 kerüljön.
Az A8 cellába vigyél be érvényesítést, ahol a forrás =Verziószám=1;Verziószám=2
Az eseményvezérelt makrót a lapodhoz kell rendelned.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim terulet As Range
If Target.Address = "$A$8" Then
Application.EnableEvents = False
Select Case Target
Case "Verziószám=1"
Set terulet = Range("B2:D4")
Case "Verziószám=2"
Set terulet = Range("G2:I4")
End Select
terulet.Copy Range("B9")
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
Ennél jóval egyszerűbben elérheted. A megnyitandó füzeted ThisWorkbook lapjához beírod ezt a makrót:
Private Sub Workbook_Open()
Sheets("Munka1").Select
Range("E2").Select
End SubHa egy füzet ThisWorkbook lapján Workbook_Open eseményvezérelt makró van, akkor a nyitásakor az végrehajtódik.
-
Delila_1
veterán
Reggel nem figyeltem eléggé.
Írj az L1 cellába – vagy ehelyett egy olyan cellába, amire biztosan nem lesz szükséged később – egy egyest. Ha másik cellát választasz, mindkét sorban írd át az L1-et.
Sub masol()
Range("A1:E5").Copy Range("A1").Offset(Range("L1") * 5)
Range("L1") = Range("L1") + 1
End SubEz a makró az A1:E5 tartományt annyiszor másolja folyamatosan egymás alá, ahányszor elindítod.
-
Delila_1
veterán
válasz
salmiakki
#2587
üzenetére
Igaz, hogy Control-t kérdeztél, de ez a makró az eddig felvitt legalsó és jobb szélső elemek bármilyen objektum alá-, és tőle jobbra 5 ponttal helyezi az új objektumot.
Sub UjElem()
Dim Bal As Single, Lent As Single, i As Long
For i = 1 To ActiveSheet.Shapes.Count
With ActiveSheet.Shapes(i)
If .Left + .Width > Bal Then Bal = .Left + .Width + 5
If .Top + .Height > Lent Then Lent = .Top + .Height + 5
End With
Next
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select
End SubAz
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select
sorban kell meghatároznod az új elem típusát. A két utolsó érték helyére írd be a kívánt szélességet, és magasságot. Ez most egy téglalapot tesz be, de ha a sor helyett ezt írod:
ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=102.75, Height:=25.5).Selectakkor egy beviteli mezőt tesz a megfelelő helyre.
Ez meg szépen egymás alá teszi a beviteli mezőket:
Sub mm()
Dim Bal As Single, Lent As Single, i As Long
For i = 1 To ActiveSheet.Shapes.Count
With ActiveSheet.Shapes(i)
If .Left > Bal Then Bal = .Left
If .Top + .Height > Lent Then Lent = .Top + .Height + 3
End With
Next
ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=69.75, Height:=24).Select
End Sub -
Delila_1
veterán
válasz
salmiakki
#2587
üzenetére
A lenti makró az újonnan betett objektum helyzetét vizsgálja, de csak az előtte berakott utolsóhoz képest. Ha az utolsó előttit takarja, üzenetet küld. Az ábrán kiemelt rész mutatja, hogy olyan esetben is jelez, ha látszólag nincs takarás, de a valóságban igen.
Sub Takar_e()
Dim elozo As Integer
Dim B_uj As Single, J_uj As Single, F_uj As Single, A_uj As Single
Dim B_elozo As Single, J_elozo As Single, F_elozo As Single, A_elozo As Single
Dim Vizsz As Boolean, Fugg As Boolean
Vizsz = False: Fugg = False
'Új alakzat adatai
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
B_uj = .Left 'bal szél
J_uj = .Left + .Width 'jobb szél
F_uj = .Top 'felső pont
A_uj = .Height + .Top 'alsó pont
End With
'Előző alakzat adatai
elozo = ActiveSheet.Shapes.Count - 1
With ActiveSheet.Shapes(elozo)
B_elozo = .Left 'bal szél
J_elozo = .Left + .Width 'jobb szél
F_elozo = .Top 'felső pont
A_elozo = .Top + .Height 'alsó pont
End With
If B_uj >= B_elozo And B_uj <= J_elozo Then Vizsz = True
If J_uj >= B_elozo And J_uj <= J_elozo Then Vizsz = True
If F_uj >= F_elozo And F_uj <= A_elozo Then Fugg = True
If A_uj >= F_elozo And A_uj <= A_elozo Then Fugg = True
If Vizsz = True And Fugg = True Then
MsgBox "Az előző (" & ActiveSheet.Shapes(elozo).Name & " nevű) objektum takarásban van", vbExclamation
Else: MsgBox "Nincs takarásban az előző objektum"
End If
End Sub
-
#2573
Delila_1
veterán
Apollo17hu
#2571
Delila_1
veterán
válasz
Apollo17hu
#2571
üzenetére
Mindenképp kapcsold be a bővítményeknél az Analysis Toolpak, és az Analysis Toolpak VBA nevűeket.
Ha más gépeken is alkalmazod a füzetedet, ott is be kell kapcsolnod. Az első a füzetben tesz elérhetővé egy rakás új függvényt, a második a VBA-ban kell a vezérlők kezeléséhez szükséges utasítások eléréséhez.
-
#2541
Delila_1
veterán
Apollo17hu
#2538
Delila_1
veterán
válasz
Apollo17hu
#2538
üzenetére
Mikor leáll hibával a makró, a Debug gombra kattints, ne az End-re.
Sárga háttérrel lesz jelölve a sor, amelyikbe belebukott. Ott az egyes változók fölé mutatva (nem rákattintva) megmutatja a pillanatnyi értéküket. Ezekből lehet következtetni a leállás okára.
-
#2537
Delila_1
veterán
Apollo17hu
#2536
Delila_1
veterán
válasz
Apollo17hu
#2536
üzenetére
A VB szerkesztőben a füzetedhez tartozó ThisWorkbook lapra kattints rá bal oldalon, akkor jobb oldalon megtalálod a leírt események makróit.
A "gyorsító" makrók valószínűleg az egyes munkalapjaidhoz vannak rendelve, a fenti leírás szerint találod meg, a munkalapokra klikkelve egyenként.
-
#2533
Delila_1
veterán
Apollo17hu
#2532
Delila_1
veterán
válasz
Apollo17hu
#2532
üzenetére
Remélem, sikerül kiszűrni.
-
#2531
Delila_1
veterán
Apollo17hu
#2530
Delila_1
veterán
válasz
Apollo17hu
#2530
üzenetére
A BeforeClose ez az esemény. Rendszerint a ThisWorkbook laphoz rendeljük. Próbáld meg lépésenként futtatni, úgy könnyebben felfedezheted a hiba okát.
-
Delila_1
veterán
Egy ismerősöm úgy oldotta meg, hogy a konvertálásnál a szöveg elé és mögé tett egy-egy csillagot.
A1 tartalmazza a szöveget, a bárkód betűtípust tartalmazó cella képlete pedig ="*" & A1 & "*"Nem minden olvasó tudja ezt követni, de náluk a munkahelyén egyikkel sem volt gond.
-
Delila_1
veterán
válasz
Vasinger!
#2485
üzenetére
Kicsit talán nehezen követhető
for valami=kistábla_első_oszlop_első_cella to kistábla_első_oszlop_utolsó_cella
on error goto beszúrás
sor=application.match(cells(valami,kistábla_első_oszlop), columns(nagytábla_első_oszlopa),0)
cells(soradik,nagytábla_második_oszlop)=cells(valami, kistábla_második_oszlop)
cells(soradik,nagytábla_harmadik_oszlop)=cells(valami, kistábla_harmadik_oszlop)
next
exit subbeszúrás:
nagytábla_első_oszlop_első_üres_cellája=cells(valami, kistábla_első_oszlop)
nagytábla_második_oszlop_első_üres_cellája=cells(valami, kistábla_második_oszlop)
nagytábla_harmadik_oszlop_első_üres_cellája=cells(valami, kistábla_harmadik_oszlop)
4 rendesen 
Új hozzászólás Aktív témák
Hirdetés
- EKWB DDC 3.1
- Gamer PC - i5 13400f, RX 6700 XT és 16gb RAM
- Szép Hp Pavilion 15-eg Kis Gamer Laptop 15,6" -45% Bivaly i7-1165G7 16/512G FHD IPS Iris Xe
- EJJ! Dell Latitude 7330 -65% "Kis Gamer" Üzleti Profi Ultrabook 13,3" i5-1245U 16/512 FHD IRIS Xe
- i5 10500/ RX6600XT/32GB DDR4/ 512GB m.2 alapú konfig/ garancia/ ingyen foxpost
- KIÁRUSÍTÁS - REFURBISHED és ÚJ - Lenovo ThinkPad Ultra Docking Station (40AJ)
- Samsung Galaxy S23 , 8/128 GB , Kártyafüggetlen
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- Nvidia Quadro P400/ P600/ P620/ P1000/ T400/ T600/ T1000 - Low profile (LP) + RTX A2000 6/12Gb
- ÁRGARANCIA!Épített KomPhone Ryzen 5 4500 16/32/64GB RAM RX 6600 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: Promenade Publishing House Kft.
Város: Budapest