Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- Brogyi: CTEK akkumulátor töltő és másolatai
- sziku69: Fűzzük össze a szavakat :)
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- eBay-es kütyük kis pénzért
- potyautas: A Magyar Néphadsereg emlékére
- btz: Internet fejlesztés országosan!
- bambano: Bambanő háza tája
-
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
bteebi
#23981
üzenetére
A laphoz rendelt eseménykezelő makróddal meghívhatsz egy modulba helyezett makrót – átadva a változók értékét –, ami már tud másik lapon is dolgozni.
Ezt általánosságban értem, Egy teljesen primitív példában az első a laphoz rendelt-, a második a modulban lévő makró. A Másik lap E1 cellájában lévő értéket felszorozza az első lapra bevitt számmal. Itt most nem térek ki a hibakezelésre, ami ellenőrizné, hogy a bevitt érték valóban szám-e, vagy nem.
Private Sub Worksheet_Change(ByVal Target As Range)
Szoroz Target 'nem szükséges Target.Value módon megadni, a Value az alapértelmezés
End Sub
Sub Szoroz(szorzo)
Sheets("Másik lap").Range("E1") = Sheets("Másik lap").Range("E1") * szorzo
End SubEbből az is látszik, hogy az átadott-, és átvett változó(k) nevének nem kell feltétlenül megegyezniük.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#23968
üzenetére
Tényleg. Ettől sem lettem sokkal okosabb.

-
Delila_1
veterán
válasz
Fire/SOUL/CD
#23966
üzenetére
Igen, de ezt füzetben, ne a kép alapján kelljen a segítőnek számolgatnia, formázgatnia. A kép alapján nem lehet meghatározni az egyes sorokat.
-
Delila_1
veterán
válasz
snorbi82
#23963
üzenetére
Ebből nem lehet kitalálni a sorazonosítókat. Mi melyik sorba kerül?
Az oszlopokat ki lehetne következtetni, de ezeket neked kellene megadnod, ne az számolgasson, aki segíteni akar.Tegyél ki egy olyan füzetet, ami 3-4 ember adatait tartalmazza, természetesen kamu névvel.
Meg egy olyant, amilyenre át kell alakítani személyenként. -
Delila_1
veterán
válasz
Geryson
#23940
üzenetére
Mint kiderült a személyes megbeszéléskor, csak a lényeg, a makró maradt le. Elnézést!
Function JobbKotjel(cella)
Dim b As Integer
For b = Len(cella) To 1 Step -1
If Mid(cella, b, 1) = "-" Then
JobbKotjel = Right(cella, Len(cella) - b) * 1
Exit Function
End If
Next
End Function -
Delila_1
veterán
válasz
dellfanboy
#23937
üzenetére

-
Delila_1
veterán
válasz
dellfanboy
#23933
üzenetére
Keress rá a Windows súgójában az alvó állapotra, ahol különböző időket rendelhetsz hozzá, vagy akár a Soha választásával megszüntetheted. Ennek a helye is eltérő verziónként.
-
Delila_1
veterán
válasz
Geryson
#23927
üzenetére
A kész függvényekkel ezt nem oldhatod meg, de írtam egy újat.
Beviszed egy új modulba, a füzetben pedig az =JobbKotjel(A1) megadja a kért eredményt.
Ha csak ebben a füzetben akarod alkalmazni, ennek egy moduljába másold be – mentés xlsm-ként –, ha több helyen, akkor a personalba másold be. -
Delila_1
veterán
válasz
Bohoc777
#23923
üzenetére
Felveszel egy kis táblázatot, ami az egyes gyümölcsöket tartalmazza. Legyen pl. a H1 cellától lefelé. Mellé beírod az árakat az I1 cellától.
A nagy táblázatodban a gyümölcs mellett az
=FKERES(A2;H:I;2;0)
képlet megadja az árat, feltételezve, hogy a nagy táblázatod az A2 cellától kezdődik. -
Delila_1
veterán
válasz
littleNorbi
#23863
üzenetére
Itt a végleges-nek látszó füzet.
-
Delila_1
veterán
válasz
Delila_1
#23872
üzenetére
Még valamit be kellett tenni a ciklusba.
For betu = 1 To Len(szoveg)
If IsNumeric(Mid(szoveg, betu, 1)) Then
szam = szam & Mid(szoveg, betu, 1)
ElseIf Mid(szoveg, betu, 1) = "/" And IsNumeric(Mid(szoveg, betu + 1, 1)) Then
If WorksheetFunction.IsEven(Left(szoveg, InStr(szoveg, "/") - 1) * 1) Then
ParosCsakSzam = szoveg
Exit Function
Else
ParosCsakSzam = ""
Exit Function
End If
ElseIf WorksheetFunction.IsEven(szam) Then
ParosCsakSzam = szam
Exit Function
Else
ParosCsakSzam = ""
Exit Function
End If
NextA 7/4-hez enélkül nullát ad.
-
Delila_1
veterán
válasz
repvez
#23873
üzenetére
Számolás nélkül szerintem nem megy, viszont gyorsan megoldhatod.
Első cellába (A1-be) 100000, másodikba (A2) 100100. Ezt lehúzod, ameddig kell. Mellette B1-be =A1*67%,
C1-be =A1*74%.A B1 és C1 cellát együtt kijelölöd, a C1 jobb alsó sarkában lévő kis fekete négyzetre duplán kattintva már kész is a teljes számításod.
-
Delila_1
veterán
válasz
m.zmrzlina
#23871
üzenetére
Közben megszületett a páros számok kigyűjtése (egyik oszlopba), a páratlanokhoz ebben a makróban át kell írni az IsEven-eket IsOdd-ra.
Function ParosCsakSzam(cella As Range)
Dim betu As Integer, szam As Integer, szoveg As String
szoveg = Trim(cella)
If IsNumeric(szoveg) Then
If WorksheetFunction.IsEven(szoveg) Then
ParosCsakSzam = szoveg
Exit Function
Else
ParosCsakSzam = ""
Exit Function
End If
Else
For betu = 1 To Len(szoveg)
If IsNumeric(Mid(szoveg, betu, 1)) Then
szam = szam & Mid(szoveg, betu, 1)
ElseIf Mid(szoveg, betu, 1) = "/" And IsNumeric(Mid(szoveg, betu + 1, 1)) Then
If WorksheetFunction.IsEven(Left(szoveg, InStr(szoveg, "/") - 1) * 1) Then
ParosCsakSzam = szoveg
Exit Function
End If
ElseIf WorksheetFunction.IsEven(szam) Then
ParosCsakSzam = szam
Exit Function
Else
ParosCsakSzam = ""
Exit Function
End If
Next
End If
End Function -
Delila_1
veterán
válasz
m.zmrzlina
#23869
üzenetére
Valamelyik hsz-ben az volt, hogy az 56/12 teljes egészében kell. Legalábbis úgy rémlik.
Láttad, hogy pl. az 1/A igazán "1/A " ?
Egy halom szóközzel a végén. -
Delila_1
veterán
válasz
m.zmrzlina
#23867
üzenetére
Már eleve nem tudom értelmezni pl. a 17.sorban lévő 13/II-I-3 féle házszámokat, de gyanítom, hogy ott nem lesz jó a 133-as eredmény.

-
Delila_1
veterán
válasz
littleNorbi
#23863
üzenetére
Kiegészítve a tegnapi makró:
Function CsakSzam(cella As Range)
Dim betu As Integer, szam As Integer
If IsNumeric(cella) Then
CsakSzam = cella
Exit Function
End If
For betu = 1 To Len(cella)
If IsNumeric(Mid(cella, betu, 1)) Then
szam = szam & Mid(cella, betu, 1)
ElseIf Mid(cella, betu, 1) = "/" And IsNumeric(Mid(cella, betu + 1, 1)) Then
CsakSzam = cella
Exit Function
Else
CsakSzam = szam
End If
Next
End Function -
Delila_1
veterán
válasz
Zola007
#23859
üzenetére
=HA(BAL(A1;1)<>"'";"'" & A1;A1)
Szóközökkel széthúzva, hogy meg lehessen különböztetni az aposztrófot az idézőjeltől:
=HA(BAL(A1;1)<>" ' ";" ' " & A1;A1)A képleteket lemásolod, majd az eredeti értékek helyére értékként beilleszted.
A még kitöltetlen cellákra pedig add meg m.zmrzlina formátumát.
-
Delila_1
veterán
válasz
littleNorbi
#23831
üzenetére
Egy saját függvénnyel megoldható.
Function CsakSzam(cella As Range)
Dim betu As Integer, szam As Integer
If IsNumeric(cella) Then
CsakSzam = cella
Exit Function
End If
For betu = 1 To Len(cella)
If IsNumeric(Mid(cella, betu, 1)) Then
szam = szam & Mid(cella, betu, 1)
Else
CsakSzam = szam * 1
End If
Next
End FunctionAlkalmazása: =csakszam(A1), az A1 cellában lévő házszám kinyeréséhez.
-
-
Delila_1
veterán
válasz
Xterms
#23808
üzenetére
Az előző verziódhoz képest az oszlopok számán kívül a két tábla sorainak a helyét is módosítottad. Ezután is teheted mindkettőt, ahova akarod, csak most már a saját károdra. Az ilyen változások a makró átírása után működnek jól. Nem viccből kérdeztem rá kétszer is, hogy hol helyezkednek el az egyes egységek.
A késésben lévő járatok a fekete táblázatban felülre kerülnek, a többiek az időpontnak megfelelően növekvő sorrendben ezek alá.
Tapasztalatból tudom, hogy a bejelentett kb. 10 perc késés lehet akár 20 is, ezért az ilyen járatokat manuálisan kell törölnöd a fekete tábláról a H:Q tartományból. Esetleg a törlés után javítod a bal oldali táblában, és újra beíratod a nyíl segítségével a jobb oldaliba.
A makró elején látsz egy értékadást.
lapnev = "Második"
Ebben írd át a Második-at a lapod végső nevére, ne feledkezz meg az idézőjelekről! -
Delila_1
veterán
válasz
Xterms
#23795
üzenetére
Szerintem jobb, ha felülről kezdődik a fekete tábla kitöltése.
Itt az újabb verzió. -
Delila_1
veterán
válasz
róland
#23800
üzenetére
If Target.Column = 7 Then ' ha a G (hetedik) oszlopban kattintasz egy cellára, akkor hajtja végre a Then ágat
sor = Target.Row 'a sor változó felveszi a kattintás helyének a sorszámát. Ha a G10-re kattintottál, a sor változó értéke 10 lesz
Application.EnableEvents = False letiltja az eseménykezelést
Range(Cells(sor, "B"), Cells(sor, "F")).Copy 'másolja a B10: F10 sort (ha a 10. sorra kattintottál)
Range("H18").PasteSpecial xlPasteValues 'a H18 cellába beilleszti az értéket
Application.CutCopyMode = False 'megszünteti a kijelöltséget
Range("B4").Select 'a B4 cellára áll
Application.EnableEvents = True 'Visszaállítja az eseménykezelést
End If 'no commentA H18 helyett nálad legyen Range("A" & Range("A3")). Az "A" helyett annak az oszlopnak a betűjelét írd, ahova másolni akarsz, a Range("A3") pedig a kiszámolt sorszámot adja.
-
Delila_1
veterán
válasz
Xterms
#23761
üzenetére
Az A oszlopba írtam az adatokat, B-be gombok helyett csak a Windings betűtípus 0240-es kódját tettem. A fekete hátterű cellák a C oszlopban vannak.
A makrót a laphoz kell rendelni.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sor As Long
sor = Target.Row
If Target.Column = 2 Then
If Cells(sor, 3) = "" Then
Cells(sor, 3) = Cells(sor, 1)
Else
Application.DisplayAlerts = False
Do While Cells(sor, 3) <> ""
Cells(sor, 3) = Cells(sor + 1, 3)
sor = sor + 1
Application.DisplayAlerts = True
Loop
End If
End If
End Sub -
Delila_1
veterán
válasz
plaschil
#23757
üzenetére
Függvénnyel nem, de egy rövid kis makróval megoldható.
Sub Hiba()
Dim ter As Range, CV As Range, usor As Long
Sheets("A").Activate
usor = Cells(1).End(xlDown).Row
Set ter = Range("A1:A" & usor)
For Each CV In ter
If CV.Interior.Color = vbRed Then Sheets("B").Cells(CV.Row, "X") = "Hiba"
Next
End SubA Sheets("A").Activate, és az
If CV.Interior.Color = vbRed Then Sheets("B").Cells(CV.Row, "X") = "Hiba"
sorokban írd be az "A" és "B" helyére a lapjaid igazi nevét, idézőjelek között. -
Delila_1
veterán
válasz
Teejay83
#23755
üzenetére
Nem tudom, melyek a "hasznos" értékek.
Két oszlop tartalmát több módon össze lehet hasonlítani. A képen ezek közül 1-et látsz. A második oszlop azt mutatja, hogy a mellette balra lévő szám melyik sorban található az E oszlopban, az F pedig a mellette lévő szám előfordulási helyét adja az A oszlopban.Használhatod még a DARABTELI függvényt, vagy makrót.
Az A és E oszlopra feltételes formázást adtam. A-ra: =HOL.VAN(A2;E:E;0)>0, E-re a fordítottja.
-
Delila_1
veterán
válasz
slashing
#23751
üzenetére
Klassz az oldal.
Többnyire ahhoz szükséges 1-1 függvény angol neve, ha makróban szeretnénk alkalmazni. Internet nélkül is megtudhatjuk a nevét.
Beírjuk a függvényt a lapra, így kipróbálhatjuk, hogy működik-e. Lapfülön jobb klikk, Beszúrás, Nemzetközi makrólap. Kapunk egy új lapot Makró1 névvel.
Átmásoljuk a függvényt tartalmazó-, valamint az(oka)t a cellá(ka)t, ami(k)re hivatkozik.Az új lapon a függvény cellájában, és a szerkesztőlécen angolul jelenik meg a függvénynév, ha rákattintunk, magyarul láthatjuk.
-
Delila_1
veterán
Igen, mindegyikre tesz, de nem kötelező minden oszlopodat szűrni. Ha csak a típust szűröd, pl. C30/37-16/F3-ra, akkor 2 féle kitét látszik, a képlet értéke 54. Ha a kitétet is szűröd XC2 XV2 XD2 XA1-re, az eredmény 47.
Jobb, ha kimutatást készítesz, új lapra.
Javaslom, hogy a Munka1 lap A2:C495 tartományát alakítsd táblázattá. Kijelöl, Beszúrás, Táblázatok, Táblázat. Ez azért jó, mert az ebből készített kimutatás ilyenkor a táblázatod bővülésekor az újabb sorok adataival is számol frissítéskor.
Ebből érdemes kimutatást készíteni.Szerk.: a C495-ben helytelen adat van!
-
Delila_1
veterán
Egyszerűen megoldható.
A 2. sorba autoszűrőt teszel. Szűröd a tartományt típusra és kitétre. Az E2 cella képlete
=RÉSZÖSSZEG(9;C:C)
Ez mindig az aktuális szűrésnek megfelelő összeget adja.Kimutatással megoldhatod a kérdésed második részét.
A sorcímkékhez adod a típust, oszlopcímkékhez a kitétet, és az értékekhez a mennyiséget. -
Delila_1
veterán
-
Delila_1
veterán
válasz
Delila_1
#23723
üzenetére
Meg is van.
Sub Oszlopok_1()
Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
Dim WF As WorksheetFunction, sorhova As Long
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
Set WF = Application.WorksheetFunction
sor = 1
WS1.Select
Do While Cells(sor, 1) <> ""
uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
sorhova = WS2.UsedRange.Rows.Count + 1
For oszlop = 1 To uoszlop
cim = Cells(sor, oszlop)
On Error GoTo Tovabb
oszlophova = WF.Match(cim, WS2.Rows(1), 0)
Cells(sor + 1, oszlop).Select
usor = Selection.End(xlDown).Row
Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
Tovabb:
On Error GoTo 0
Next
sor = Range("A" & sor).End(xlDown).Row
sor = Range("A" & sor).End(xlDown).Row
Loop
End Sub -
Delila_1
veterán
válasz
slashing
#23720
üzenetére
Nem teljesen olyan, mint a képen, de hasonlít.
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.Sub Oszlopok()
Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
Dim WF As WorksheetFunction, sorhova As Long
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
Set WF = Application.WorksheetFunction
sor = 1
WS1.Select
Do While Cells(sor, 1) <> ""
uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
For oszlop = 1 To uoszlop
cim = Cells(sor, oszlop)
On Error GoTo Tovabb
oszlophova = WF.Match(cim, WS2.Rows(1), 0)
Cells(sor + 1, oszlop).Select
usor = Selection.End(xlDown).Row
sorhova = WS2.Cells(Rows.Count, oszlophova).End(xlUp).Row + 1
Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
Tovabb:
On Error GoTo 0
Next
sor = Range("A" & sor).End(xlDown).Row
sor = Range("A" & sor).End(xlDown).Row
Loop
End Sub -
Delila_1
veterán
A2-től lefelé vannak a megnevezések, B2-től mellettük az adatok.
D1-től jobbra bevittem a keresendő megnevezéseket, ezek alá írja a makró a találatokat. A példád szerintD1 -> barack
D2 -> őszi
D3 -> kajsziE1 -> alma
E2 -> piros
E3 -> zöldSub kigyűjt()
Dim oszlop As Integer, usor As Long, uoszlop As Integer
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "D"), Cells(400000, uoszlop)) = ""
Range("A1").Select
For oszlop = 4 To uoszlop
Selection.AutoFilter Field:=1, Criteria1:=Cells(1, oszlop)
usor = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & usor).Select
Selection.Copy Cells(2, oszlop)
Next
Selection.AutoFilter
End SubÍrhatsz bele képernyőfrissítés tiltást-, engedélyezést.
-
Delila_1
veterán
Az A oszlop minden sorába be kell írnod a dátumot. Ez pár kattintással megoldható.
Ha zavar a sok dátum látványa, egy feltételes formázással "eltüntetheted", a háttér színére váltva a karakterek színét ott, ahol a dátum azonos a fölötte lévő sor dátumával.
-
Delila_1
veterán
válasz
Mr.Scofield
#23648
üzenetére
-
Delila_1
veterán
válasz
Mr.Scofield
#23641
üzenetére
3 féle választ kaptál, amiből már az újonnan feltett két gomb makróját kikövetkeztetheted.
Módosításnál a textboxok (cellák?) értékeit beviszed az adatokat tartalmazó cellákba
Sheets("Munka1"). Range("A" & sor)=TextBox1Törlésnél sheets("Munka1").Rows(sor).Delete Shift:=xlUp
-
Delila_1
veterán
válasz
Mr.Scofield
#23637
üzenetére
Harmadik megoldás, nem userform, de nem is makró nélkül.
Nem írtad az Excel verzióját, ezért 2003-ban írtam meg, azt mindegyik érti.A Kiírás lapon a kitöltendő mezők nem textboxok, csak formázott cellák.
-
Delila_1
veterán
válasz
Mittu88
#23626
üzenetére
2007-től így tehetsz ki ikont.
-
Delila_1
veterán
válasz
csferke
#23622
üzenetére
Tudtommal nem lehet ezt a formátumot megadni, de m.zmrzlina makrójával a kijelölt területen könnyedén átállíthatod a formátumot.
-
Delila_1
veterán
válasz
m.zmrzlina
#23619
üzenetére
Ez teljesen korrekt, ám a kérdezőnek a képlet másolásával is gondja van.

-
Delila_1
veterán
Az Excel nem szövegszerkesztő, azért nem az ilyen formaságokra van kihegyezve.
Vegyük, hogy a kisbetűkkel írt szövegeid az A2:A10 tartományban vannak.
Egy üres oszlop 2. sorába, pl. B2-be beírod a képletet: =NAGYBETŰS(A2)
Ezen a cellán állva keret látszik a cellán, a jobb alsó sarkában egy kis fekete négyzettel. Az egérrel erre a négyzetre mutatsz, ekkor az egérmutató kereszt alakú lesz. A bal gombbal "megfogod", és lehúzod a B10 celláig. Végig lemásoltad a képletet az adataid mellé. -
Delila_1
veterán
A függvény neve NAGYBETŰS.
Van egy másik, a TNÉV, ami a hivatkozott szöveg minden szavának első betűjét nagyra-, a többit kicsire állítja. Ez neveknél hasznos.
A függvényeket "lehúzva" tudod az összes cellában nagybetűsre cserélni a szöveget. Ezután irányított beillesztéssel rámásolhatod a függvényt tartalmazó cellák értékét az eredeti cellákra.
-
Delila_1
veterán
válasz
m.zmrzlina
#23600
üzenetére
Egyszerűbben is meg lehet oldani az oszlopok törlését.
Sub OszlopTorles()
Dim oszlop As Integer
For oszlop = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
If Cells(1, oszlop) >= "S01" And Cells(1, oszlop) <= "S099" Then
Columns(oszlop).Delete Shift:=xlToLeft
End If
Next
End SubSorok, oszlopok törlésénél mindig az utolsó helytől indulunk az első felé.
-
Delila_1
veterán
válasz
Carasc0
#23585
üzenetére
Gondolom, a rengeteg adat hosszú időn át gyűlt fel. Az egyes sorokban lévő képletek frissülése hosszú időt vesz igénybe. A helyedben azokat a képleteket, függvényeket szüntetném meg, amiknek az eredménye már biztosan nem változik, például az előző évi adatoknál.
Ezt az irányított beillesztéssel szüntetheted meg, ahol a képleteket tartalmazó cellákat másolod, és irányítottan, értékként ugyanoda beilleszted.
-
Delila_1
veterán
válasz
nebulo0128
#23582
üzenetére
Ha PowerPoint-tal próbálkoztál, akkor jó lesz a Fényképezőgép funkció. Kiteheted az ikonját.
2003-es verzióig Testreszabás, Parancsok fül, Eszközök kategória. A jobb oldalon megjelenő ikonok közül a Fényképezőgép-ét felhúzod az ikonok közé.
2007-től Gyorselérési eszköztár, További parancsok, a Választható parancsok helye legördülőből a Minden parancs-ot választod. Az alatta lévő táblába lépve egy F nyomására az első f-fel kezdődő parancsra lépsz, innen kikeresed a Fényképezőgép-et. A Felvétel gombbal átmásolod a jobb oldali táblába. OK után megjelenik a Gyorselérési eszköztáron.
Alkalmazása:
Kijelölöd a tartományt, amit mindig látni akarsz, majd az ikonra kattintasz. Ekkor szálkereszt alakú lesz az egér mutatód, ezzel rajzolsz egy négyszöget. Módosíthatod a szokásos módon a méretét. Olyan helyre tedd, ami szem előtt van, pl. a felső sorokba, amiket rögzítettél az ablaktábla rögzítése funkcióval.Amint változtatsz a kijelölt táblában valamit, azonnal látod az új értéket a fényképezőgép ablakában.
-
-
Delila_1
veterán
válasz
m.zmrzlina
#23508
üzenetére
Szivi.

-
Delila_1
veterán
válasz
m.zmrzlina
#23504
üzenetére
Set wsTemp = workbooks("wbTemp.xlsx").Worksheets("Munka2")
Nem célszerű az éppen aktív lapra hivatkozni változó értékének a megadásánál.
Set wsOsszesito = sheets("Osszesito")
-
Delila_1
veterán
válasz
m.zmrzlina
#23501
üzenetére
wsTemp.Range("A1").CurrentRegion.Copy Destination:=wsOsszesito.cells(1, elsoures_oszlop)
-
Delila_1
veterán
válasz
m.zmrzlina
#23490
üzenetére
Ezért alkalmazok szívesebben a tartalmukra utaló nevű változókat, mint pl. sor, és oszlop.

-
Delila_1
veterán
válasz
m.zmrzlina
#23488
üzenetére
Jobban látszik a haladás sorrendje, ha a Cells(i, j).Select sor helyett
MsgBox Cells(i, j).Address szerepel a makrókban.
-
Delila_1
veterán
válasz
slashing
#23474
üzenetére
Sub tele_e()
Dim usor As Long, uoszlop As Integer, oszlop As Integer, maxx As Long, f As Boolean
uoszlop = Range("D4").End(xlToRight).Column
For oszlop = 4 To uoszlop
usor = Cells(Rows.Count, oszlop).End(xlUp).Row
If usor > maxx Then maxx = usor
Next
For oszlop = 4 To uoszlop
If Application.CountA(Range(Cells(4, oszlop), Cells(maxx, oszlop))) <> maxx - 4 + 1 Then
f = True
End If
Next
If f Then MsgBox "Hiányos" Else MsgBox "Rendben"
End Sub -
Delila_1
veterán
válasz
slashing
#23472
üzenetére
Sub tele_e()
Dim sorok As Long, oszlopok As Integer
Range("A4").Select
Selection.CurrentRegion.Select
sorok = Selection.Rows.Count: oszlopok = Selection.Columns.Count
If sorok * oszlopok <> Application.CountA(Selection) Then
MsgBox "Hiányos kitöltés"
Else
MsgBox "Rendben"
End If
End Sub -
Delila_1
veterán
válasz
Mittu88
#23464
üzenetére
Próbáld ki Munka1-ről indítva a lentieket.
A change eseményt a Munka1 laphoz vidd be, a másikat modulba.Private Sub Worksheet_Change(ByVal Target As Range)
MásikMakró Target.Row, Target.Column, Target.Value
End Sub
Sub MásikMakró(sor, oszlop, nev)
Munka2.Cells(sor, oszlop) = nev
End SubVáltozók értékét így is átadhatod másik makrónak. Arra ügyelj, hogy a fogadó makróban ugyanaz legyen a változók sorrendje, mint az indítóban. Látod, nem kell azonosaknak lenniük a neveknek, ám a Change makróban felvehetsz 3 változót az átadáshoz – de minek?
-
Delila_1
veterán
válasz
bteebi
#23407
üzenetére
Teljesen jó lenne (szemre, nem próbáltam ki), ha nem lennének az 5. sorban összevont cellák.
Javaslom, hogy a 4. sorban minden cellába írd be a Város 1-et, Város 2-t, stb. Itt a karakterek színe egyezzen meg a háttér színével, és erre az új sorra hivatkozz. El is rejtheted a 4. sort. -
Delila_1
veterán
Sub megnyit()
Dim FN As String
FN = "MegadottNev.xlsm"
On Error GoTo Nyit
Workbooks.Open "C:\Temp\proba.xlsx"
On Error GoTo 0
GoTo Folytatas
Nyit:
Workbooks.Open "C:\Temp\alapfile.xlsx"
On Error GoTo 0
Folytatas:
'Ide jön a pár adat kitöltése
'mentés a megadott mappába, az FN változóban megadott névvel
ActiveWorkbook.SaveAs Filename:="C:\Temp\" & FN, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub -
Delila_1
veterán
válasz
slashing
#23400
üzenetére
Azért egy másik, ami azt figyeli, hogy a saját felhasználói neveddel léptél-e be.
Sub mmmm()
Dim nev$
nev$ = Application.InputBox("Add meg a neved!", "Név bekérése", , , , , , 2)
If nev$ <> Environ("username") Then
MsgBox ("Te kis huncut, nem vagy jogosult a füzetet használni!"), vbOKOnly + vbExclamation
Exit Sub
Else
MsgBox "Tovább..."
'makró többi része
End If
End Sub -
Delila_1
veterán
válasz
slashing
#23396
üzenetére
Beviszed a neveket egy oszlopba. Táblázattá alakítod, és a Nevek névvel látod el a tartományt.
Sub mm()
Dim nev$, tomb(), v As Integer, megvan As Boolean
nev$ = Application.InputBox("Add meg a neved!", "Név bekérése", , , , , , 2)
tomb = Application.Transpose(Range("Nevek"))
For v = 1 To UBound(tomb)
If nev$ = tomb(v) Then
megvan = True
Exit For
End If
Next
If megvan = False Then
MsgBox "Nem szerepelsz a nevek között!"
Exit Sub
Else
MsgBox nev$ & " a(z) " & v & ". helyen szerepel."
'makró többi része
End If
End SubBővítheted agyba-főbe a tartományt.
Új hozzászólás Aktív témák
- LG 32SQ700S-W - 32" VA Smart - 3840x2160 4K UHD - 62Hz 5ms - WebOS - Wifi + BT - USB-C - Hangszórók
- REFURBISHED és ÚJ - Lenovo ThinkPad Ultra Docking Station (40AJ)
- Bomba ár! HP EliteBook 840 G6 - i7-8GEN I 16GB I 512GB SSD I 14" FHD I HDMI I Cam I W11 I Gari!
- Bomba ár! Dell Latitude E5550 - i5-5GEN I 8GB I 128SSD I 15,6" FHD Touch I HDMI I W10 I Cam I Gari!
- LG 55QNED86T3A / QNED / 55" - 139 cm / 4K UHD / 120Hz / HDR Dolby Vision / FreeSync Premium / VRR
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi





Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.



