-
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
-
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.
-
#23969
Delila_1
veterán
Fire/SOUL/CD
#23968
Delila_1
veterán
válasz
Fire/SOUL/CD
#23968
üzenetére
Tényleg. Ettől sem lettem sokkal okosabb.
-
#23967
Delila_1
veterán
Fire/SOUL/CD
#23966
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 -
#23939
Delila_1
veterán
dellfanboy
#23937
Delila_1
veterán
válasz
dellfanboy
#23937
üzenetére
-
#23935
Delila_1
veterán
dellfanboy
#23933
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. -
#23878
Delila_1
veterán
littleNorbi
#23863
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.
-
#23872
Delila_1
veterán
m.zmrzlina
#23871
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 -
#23870
Delila_1
veterán
m.zmrzlina
#23869
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. -
#23868
Delila_1
veterán
m.zmrzlina
#23867
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.
-
#23866
Delila_1
veterán
littleNorbi
#23863
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.
-
#23832
Delila_1
veterán
littleNorbi
#23831
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
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.
-
#23653
Delila_1
veterán
Mr.Scofield
#23648
Delila_1
veterán
válasz
Mr.Scofield
#23648
üzenetére
-
#23643
Delila_1
veterán
Mr.Scofield
#23641
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
-
#23640
Delila_1
veterán
Mr.Scofield
#23637
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.
-
#23621
Delila_1
veterán
m.zmrzlina
#23619
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.
-
#23604
Delila_1
veterán
m.zmrzlina
#23600
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.
-
#23584
Delila_1
veterán
nebulo0128
#23582
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.
-
-
-
-
#23512
Delila_1
veterán
m.zmrzlina
#23508
Delila_1
veterán
válasz
m.zmrzlina
#23508
üzenetére
Szivi.
-
#23507
Delila_1
veterán
m.zmrzlina
#23504
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")
-
#23502
Delila_1
veterán
m.zmrzlina
#23501
Delila_1
veterán
válasz
m.zmrzlina
#23501
üzenetére
wsTemp.Range("A1").CurrentRegion.Copy Destination:=wsOsszesito.cells(1, elsoures_oszlop)
-
#23491
Delila_1
veterán
m.zmrzlina
#23490
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.
-
#23489
Delila_1
veterán
m.zmrzlina
#23488
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
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.
Új hozzászólás Aktív témák
Hirdetés
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- Kertészet, mezőgazdaság topik
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Viccrovat
- Bestbuy játékok
- Továbbfejlődött a Keychron egéralternatívája a Logitech MX Masterre
- Gaming notebook topik
- Proxmox VE
- Házimozi haladó szinten
- PlayStation 1 / 2
- További aktív témák...
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Assassin's Creed Shadows Collector's Edition PC
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- ÁRGARANCIA!Épített KomPhone i9 14900KF 32/64GB RAM RTX 5070Ti 16GB GAMER PC termékbeszámítással
- Telefon felvásárlás!! Samsung Galaxy A50/Samsung Galaxy A51/Samsung Galaxy A52/Samsung Galaxy A53
- LG 27CN650N-6A - Felhő Monitor - 1920x1080 FHD - 75Hz 5ms - USB Type-C - Quad Core - BT + WiFi
- Dymo LabelWriter 400 - Hőpapíros címkenyomtató
- Beszámítás! Sony PlayStation 5 825GB SSD lemezeskonzol extra játékokkal garanciával hibátlan működés
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged