- Apple iPhone 16 Pro - rutinvizsga
- Honor 400 Pro - gép a képben
- Mi nincs, grafén akku van: itt a Xiaomi 11T és 11T Pro
- Csak semmi szimmetria: flegma dizájnnal készül a Nothing Phone (3)
- Vivo V40 5G - az első benyomás fontos
- Vivo X200 Pro - a kétszázát!
- Samsung Galaxy A56 - megbízható középszerűség
- Android alkalmazások - szoftver kibeszélő topik
- CMF Buds Pro 2 - feltekerheted a hangerőt
- iPhone topik
- A Bosch szerint Európának nem kellene az AI-t a halálba szabályozni
- Nehéz helyzetben az SMIC, régebbi chipet használ az új Huawei laptop
- Norvégia átmenetileg betiltja az áramigényes kriptobányászatot
- One otthoni szolgáltatások (TV, internet, telefon)
- Telekom otthoni szolgáltatások (TV, internet, telefon)
-
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
Szicskeee
#29778
üzenetére
A másik lapon (Munka2) lévő gomb click eseményébe írd be azt, amit az elsőn lévő gomb eseményébe írnál.
Private Sub CommandButton2_Click()
Sheets("Munka1").Range("A1") = "asdf"
End SubAz első lap gombjának az eseménye is tartalmazhatja ugyanezt, csak ott a lapra történő hivatkozást felesleges megadni.
-
Delila_1
veterán
válasz
Szicskeee
#29773
üzenetére
Private Sub CommandButton14_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
strPrompt = "Ki szeretnéd nyomtatni xyz prémium adatlapját??"
strTitle = "Prémium"
iRet = MsgBox(strPrompt, vbYesNo, strTitle)
If iRet = vbNo Then
MsgBox "Vége!"
Else
Worksheets("Prem1").Range("$A$1:$O$39").PrintOut Copies:=1, Collate:=True
End If
End SubSzerk: elkéstem.
-
Delila_1
veterán
válasz
Zimmy88
#29753
üzenetére
Most gyorsabb lesz. Folytatnod kell az elso = 8: ucso = 9: GoSub Atir típusú sorokat.
Az oszlopok törlése részbe a saját törlendő oszlopaidat írd be.Sub mm()
Dim lap As Integer, nev As String, utvonal As String
Dim elso As Long, ucso As Long
utvonal = "D:\kiment\"
For lap = 1 To Worksheets.Count
If Sheets(lap).Range("B1") = "ez kell" Then
Sheets(lap).Select
elso = 8: ucso = 9: GoSub Atir
elso = 12: ucso = 14: GoSub Atir
elso = 16: ucso = 17: GoSub Atir
elso = 20: ucso = 22: GoSub Atir
'*** stb ***
'oszlopok törlése
Range("B:D,F:F").Delete Shift:=xlToLeft
nev = ActiveSheet.Name
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=utvonal & nev & ".xlsx"
ActiveWindow.Close
End If
Next
Exit Sub
Atir:
Range("E" & elso & ":W" & ucso).Copy
Range("E" & elso).PasteSpecial xlPasteValues
Return
End Sub -
Delila_1
veterán
válasz
Zimmy88
#29749
üzenetére
Nem érdemes a teljes sorokat megadni, mert egy halom üres cellán is végig kellene mennie a ciklusnak. Ehelyett területet adj meg.
Sub mm()
Dim lap As Integer, r As Range, nev As String, utvonal As String
Dim terulet As Range
utvonal = "C:\Temp\"
For lap = 1 To Worksheets.Count
Sheets(lap).Select
Set terulet = Range("A4:J4,A9:J11,A16:J16")
For Each r In terulet
Range(r.Address) = r.Value
Next
nev = ActiveSheet.Name
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=utvonal & nev & ".xlsx"
ActiveWindow.Close
Next
End Sub -
Delila_1
veterán
válasz
MCGaiwer
#29748
üzenetére
Az AK3 képlete legyen
=HA(DARABTELI(F3:AJ3;"x")>0;DARABTELI(F3:AJ3;"x");"")
az AL3-é pedig
=HA(DARABTELI(F3:AJ3;"<>x")-DARABTELI(F3:AJ3;"")>0;DARABTELI(F3:AJ3;"<>x")-DARABTELI(F3:AJ3;"");"")
Az AK3-ban próbáltam az egyszerűbbnek tetsző HAHIBA függvénnyel megoldani, de ledolgozott napok esetén az üres string helyett 0 értéket ad.
Figyelj, hogy a többi hónapban a megfelelő területet add meg a képletekben.
-
#29747
Delila_1
veterán
m.zmrzlina
#29746
Delila_1
veterán
válasz
m.zmrzlina
#29746
üzenetére
Jogos! Én is emlékeztem rá, de lusta voltam kikeresni.
-
Delila_1
veterán
válasz
MCGaiwer
#29739
üzenetére
Közben összeállítottam egy egyszerűbbet, egész évre.
Vigyázz, a 2. sorban 2013-as dátumok szerepeltek. Fontos, hogy az aktuálisak legyenek ott a feltételes formázás miatt, ami a hétvégék, ünnepnapok, és áthelyezett munkanapok hátterét adja.
Jövőre a Munka1 lapon át kell írnod a dátumokat, vagy csak folytatnod a listákat a 2016-osakkal.
-
-
#29715
Delila_1
veterán
lizakattila
#29714
Delila_1
veterán
válasz
lizakattila
#29714
üzenetére
Az
If Target.Column <> 2 Then Exit Sub
sorban a 2 helyett írj 15-öt, és a
Target.Offset(0, -1).Value = Now()
sorban a -1 helyett -14-et.
-
#29703
Delila_1
veterán
Batistuta7
#29702
Delila_1
veterán
válasz
Batistuta7
#29702
üzenetére
Ha jól értem, az első lapra írod be az AC oszlopba a napi állásidőt az egyes gépekhez. Ezeket kell összesíteni a második lapon, ahol az A oszlop tartalmazza a gépek nevét, az első sor pedig a hét napját.
Fontos, hogy a 2 lapon megegyezzen a gépek neve, tehát ha az első lapon P1 a név, a másodikon is az legyen, nem 1.
Az első laphoz rendeltem egy eseményvezérelt makrót. Mikor beírod egy géphez az állásidőt, a második lapon a megfelelő géphez, és az aktuális naphoz beírja az értéket.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WSO As Worksheet, sor, oszlop As Integer
Set WSO = Sheets("Összesítés")
If Target.Column = 29 And Target > "" Then
sor = Application.Match(Cells(Target.Row, 1), WSO.Columns(1), 0)
If VarType(sor) = vbError Then
sor = Application.Match(Cells(Target.Row - 1, 1), WSO.Columns(1), 0)
End If
oszlop = Application.Weekday(Date, 2) + 1
WSO.Cells(sor, oszlop) = WSO.Cells(sor, oszlop) + Target
End If
End SubA második lap J oszlopába betettem egy összesítést.
Nézd meg a csatolt füzetben a cellaformázást az első lap AC; valamint a második lap B:H és J oszlopában. -
#29646
Delila_1
veterán
the radish
#29645
Delila_1
veterán
válasz
the radish
#29645
üzenetére
=ha(a1<0;"-" & jobb("0" & a1;3);jobb("0" & a1;3))
-
#29644
Delila_1
veterán
the radish
#29643
Delila_1
veterán
válasz
the radish
#29643
üzenetére
Nincs mit.
-
#29641
Delila_1
veterán
the radish
#29640
Delila_1
veterán
válasz
the radish
#29640
üzenetére
=jobb("0" & a1;3)
-
#29625
Delila_1
veterán
m.zmrzlina
#29624
Delila_1
veterán
válasz
m.zmrzlina
#29624
üzenetére
Szívesen, örülök, hogy sikerült.
-
#29621
Delila_1
veterán
m.zmrzlina
#29610
Delila_1
veterán
válasz
m.zmrzlina
#29610
üzenetére
Amint megírtam a makrót, elszállt az internet, de most visszajött.
Sub Szetcincal()
Dim oszlop As Integer, usor As Long
Dim szoveg As String, betu As Integer
Dim szoveg1 As String, nagy As Integer
Dim ekezet As String
' Csere
With Columns("A:Z")
.Replace What:=",", Replacement:=""
.Replace What:=" ", Replacement:=""
End With
ekezet = "á,é,í,ó,ö,ő,ú,ü,ű"
For oszlop = 1 To 26 'A:Z oszlopok
Kezd:
szoveg = Cells(1, oszlop)
szoveg1 = ""
nagy = 0
For betu = 1 To Len(szoveg)
Do
If betu = 1 Then
szoveg1 = Left(szoveg, 1)
GoTo Tovabb
End If
If (Asc(Mid(szoveg, betu, 1)) > 96 And Asc(Mid(szoveg, betu, 1)) < 123 And _
betu > 1) Or InStr(ekezet, Mid(szoveg, betu, 1)) > 0 Then
szoveg1 = szoveg1 & Mid(szoveg, betu, 1)
Else
nagy = nagy + 1
usor = Cells(Rows.Count, oszlop).End(xlUp).Row + 1
Cells(usor, oszlop) = szoveg1
szoveg = Right(szoveg, Len(szoveg) - Len(szoveg1))
Cells(1, oszlop) = szoveg
GoTo Kezd
End If
Loop While nagy <> 0
Tovabb:
Next
Next
End Sub -
#29608
Delila_1
veterán
m.zmrzlina
#29600
Delila_1
veterán
válasz
m.zmrzlina
#29600
üzenetére
Az =A1=B1 képlet IGAZ, vagy HAMIS eredményt ad, nem szükséges HA függvénybe beágyazni.
-
-
-
Delila_1
veterán
válasz
karlkani
#29568
üzenetére
A 2. kérdésedre a válasz, hogy én írtam el. A makróban 2× szerepel, írd át.
Az első kérdésre:
Bevittem 2 segédtáblát a H, ill. a J oszlopba. Az első az idei, hátralévő ünnepnapokat tartalmazza, a második pedig a munkanap áthelyezést. Ehhez pluszban írtam a nov.6-ot, hogy látsszon a formázás.
A 2 segédtábla az Ünnepek, ill. a Mn névre hallgat. Mindkét segédtábla bővíthető, átírható jövőre.A képen látszik a B:C tartomány feltételes formázása.
Képletek a formázáshoz:
=DARABTELI(Mn;$B2)>0
=VAGY(HÉT.NAPJA($B2;2)>5;DARABTELI(Ünnepek;$B2)>0)Szerk.: Fontos a két feltétel sorrendje!
-
-
Delila_1
veterán
válasz
karlkani
#29563
üzenetére
Póbáld ezzel:
Function SubMyColor(tartomány, Szinkod)
Dim CV As Range, osszeg As Double
Application.Volatile
For Each CV In tartomány
If CV.Font.ColorIndex = Szinkod Then osszeg = osszeg + CV
Next
SubMyColor = osszeg
End FunctionAz osszeg változónak lebegőpontos típust adtam, mert nem tudom, egész-, vagy törtszámok szerepelnek a tartományodban.
-
Delila_1
veterán
válasz
róland
#29555
üzenetére
Az INDEX függvény első paramétere a tartomány, amiben keresel. Nem látom ezt az egyszerűsített függvényedben.
A HOL.VAN függvény 3. paraméterében a 0 adja a pontos keresést, az 1 a közelítőt. Az utóbbi azt a legnagyobb értéket adja eredményül, ami kisebb, vagy egyenlő a keresési értékkel. Ehhez emelkedő sorrendben kell lennie a keresési tartománynak.
A 3. paraméter lehet még -1 is, ami fordítottja az 1-nek.
-
-
Delila_1
veterán
válasz
sztanozs
#29524
üzenetére
Egyelőre az adatok elhelyezése sem ismeretes.
Az eredeti kérdés szerint laponként (emberenként) lehet, hogy heti 1, vagy 2 oszlop van. Az meg végképp nem derül ki, hogy melyek ezek az oszlopok. Míg ez nem derül ki, szerintem nem érdemes foglalkozni vele.
Egy belinkelt kép eloszlathatná a bizonytalanságokat. -
#29517
Delila_1
veterán
TrollBalint
#29515
Delila_1
veterán
válasz
TrollBalint
#29515
üzenetére
Még annyit, hogy az emberek lapjain mindenhol van címsor.
-
#29516
Delila_1
veterán
TrollBalint
#29515
Delila_1
veterán
válasz
TrollBalint
#29515
üzenetére
Nem írtad meg az adatok pontos elhelyezkedését, nem vetted figyelembe a Téma összefoglalóban leírtakat. Ezért úgy írtam egy makrót a megoldáshoz, ahogy elképzeltem, majd átírod.
Az első lap neve Adatok, ennek az A oszlopában vannak a tantárgyak, a B-ben a hozzá tartozó értékek.
A többi lap az egyes emberek adatait tartalmazza. Az A oszlopban választod ki az I. héthez tartozó tantárgyakat, a B-ben a II. hetit, az AZ-ben az 52. hetit.Az összes pontszám mindegyik lapon a BA1 cellában jelenik meg a makró futtatása után.
Sub OsszesPont()
Dim lap As Integer, ter As Range, CV As Range, pontok As Double
For lap = 2 To Sheets.Count
Set ter = Sheets(lap).Range("A1").CurrentRegion.Offset(1, 0)
pontok = 0
For Each CV In ter
If CV > 0 Then
pontok = pontok + Application.WorksheetFunction.VLookup(CV.Value, Sheets("Adatok").Range("A:B"), 2, 0)
End If
Next
Sheets(lap).Range("BA1") = pontok
Next
End Sub -
#29507
Delila_1
veterán
MaurerJani
#29506
Delila_1
veterán
válasz
MaurerJani
#29506
üzenetére
Nincs mit.
-
#29505
Delila_1
veterán
MaurerJani
#29504
Delila_1
veterán
válasz
MaurerJani
#29504
üzenetére
=SZUM(INDIREKT("H3:H" & I1)), ahol az I1 cella értéke 5.
-
#29431
Delila_1
veterán
m.zmrzlina
#29429
Delila_1
veterán
válasz
m.zmrzlina
#29429
üzenetére
Nincs mit.
-
#29427
Delila_1
veterán
m.zmrzlina
#29426
Delila_1
veterán
válasz
m.zmrzlina
#29426
üzenetére
Nálad elég sok változó van, amiknek az eredete nem látható az ábrán.
A lenti makró üzenetet küld, ha a Dkioszt aktuális cellája nem üres, és nem azonos a tőle 2 oszloppal balra lévő tartomány azonos sorával.
Sub mm()
Dim rng_Dkioszt As Range, CV As Range
Set rng_Dkioszt = Range("E2:E15")
For Each CV In rng_Dkioszt
If CV.Value > "" And CV.Value <> Range(CV.Address).Offset(, -2) Then
MsgBox "Eltérés a(z) " & CV.Row & ".sorban"
End If
Next
End Sub -
Delila_1
veterán
válasz
Márkó20
#29414
üzenetére
A Summary lap C2 képletét írom le, a többi ugyanarra a kaptafára készült.
Az INDEX függvénnyel keressük ki a megfelelő értéket. Ennek a szintaktikája
=INDEX(tartomány;sor;oszlop)A tartomány, amiben keresünk, az Outbound lap I:K oszlopa, ahol az I tartalmazza a keresett hetet, a J és K a két hozzá tartozó értéket. Másik lapon lévő tartományra úgy hivatkozunk, hogy megadjuk a lap nevét, majd felkiáltójel után a tartományt.
A sort a HOL.VAN függvénnyel keressük meg.
=HOL.VAN(keresési_érték;hol_keressük;egyezés_típusa)
Az Outbound lapon TOTAL OUTBOUND wk1 módon szerepel a hét, a Summary lapon csak 1-es számmal. Ezért a keresési_érték "TOTAL OUTBOUND wk"&$A2, vagyis a szöveghez hozzáfűzzük a hét számát tartalmazó A2 cella értékét. A hol_keressük az Outbound lap I oszlopa. Az egyezés_típus értéke itt nulla, ennek a jelentését megtalálod a súgóban.Most már tudjuk, hogy az első hét adatait az Outbound lap 17. sorában találjuk. Már csak az oszlopot kell megadni az értékek kikereséséhez.
A Summary lap C oszlopába a tartományunk (I:K) 2. oszlopának az adata kell, a D-be pedig a 3. oszlopé.Az egészet egy HAHIBA függvénybe ágyaztam be, másképp azokban a sorokban, ahol nem talál az INDEX megfelelő értéket – nincs még megadva a heti érték az Outbound lapon –, #HIÁNYZIK hibaérték jelenne meg, és ez csúnya.
=HAHIBA(érték;hiba_esetén). Itt az érték az INDEX függvény eredménye, hiba esetén nulla értéket ír be, mert azt adtuk meg. -
Delila_1
veterán
válasz
lenkei83
#29396
üzenetére
Elég nehéz más gondolatmenetét követni, legalábbis nekem.
Arra figyeltem fel, hogy a Havi2015 és a Havi2016 makró összesen 3 helyen tér el, hasonlóan a Kum2015 és Kum2016-hoz.
Valószínű, hogy 1 makróba tettem volna a kettőt, pl. Évek címmel. Az egészet egy for-next-be tenném, ami 1-től 2-ig tart. Az eltérő soroknál feltételt tettem volna be.for év=1 to 2
...
if év=1 then set month1=range("month1") else set month1=range("month2")
...
next -
Delila_1
veterán
válasz
poffsoft
#29372
üzenetére
Poffsoft , Belnir és bsh
Tegnap csak a lényeg maradt ki, a figyelt lapok változásának a követése.
A megfigyelt laphoz kell rendelni a lenti 2 makrót, hogy az ezen történt változásokat is tárolják a Rejtett lapon. A "Rejtett" lap Visible tulajdonságát eleve xlSheetVeryHidden-re lehet állítani, azért a makró tud bele írni.
Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
If Target.Count <> 1 Then Exit Sub
If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rejtett")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & lastrow)
.Offset(0, 0) = Target.Parent.Name 'A – hol volt változás
.Offset(0, 1).Value = Target.Address 'B – Változás helye
.Offset(0, 2).Value = Now() 'C – időpont
.Offset(0, 3).Value = aktualis 'D – változás előtti adat
.Offset(0, 4).Value = Target.Value 'E – változtatás utáni érték
.Offset(0, 5).Value = Environ$("username") 'F – felhasználó neve
.Offset(0, 6).Value = Environ$("computername") 'G – PC neve
.Offset(0, 7).Value = Environ$("userdomain") 'H – felh. domain
End With
End With
Worksheets(akt_lap).Activate
Selection.Activate
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub -
Delila_1
veterán
válasz
Márkó20
#29369
üzenetére
Hát ezekről a sorazonosítók lemaradtak. Az sem látszik, melyik lap milyen névre hallgat.
Legjobb lenne, ha feltöltenéd a füzetet egy elérhető helyre (pl. a data.hu-ra), mindegyik lapon pár sor adattal. Ahol összesíteni akarod, ott billentyűzetről vidd be, minek kell majd ott szerepelnie. Jelölheted ezeket a cellákat pl. sárga háttérrel.
Mikor feltöltötted a füzetet, másold a megadott linket. Gyere ide vissza. A válasznál a Link gombot nyomd meg, és a megjelenő rovatba illeszd be a linkedet.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Belnir
#29332
üzenetére
A füzetben egy lapot átnevezel, legyen a neve Rejtett.
Az első sorba A1-től H1-ig beírod a címeket:
Akció | Változás helye | Időpont | Változás előtt | Vált. után | Felh. neve | PC neve | Felh. domainEzt a lapot elrejtheted.
A füzetedben Alt+F11-re bejön a VB szerkesztő.
Bal oldalon kiválasztod a füzeted nevét. Ha a név előtt + jel van, rákattintasz.
Megjelenik (többek közt) a ThosWorkbook lap. Erre kattintasz. Jobb oldalon kapsz egy nagy üres felületet.
Oda másold be a lenti makrót.Private Sub Workbook_Open()
Dim lastrow As Long
Application.ScreenUpdating = False
With Worksheets("Rejtett")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & lastrow)
.Offset(0, 0).Value = "OPEN"
.Offset(0, 1).Value = ThisWorkbook.FullName
.Offset(0, 2).Value = Now()
.Offset(0, 3).Value = "'*"
.Offset(0, 4).Value = "'*"
.Offset(0, 5).Value = Environ$("username")
.Offset(0, 6).Value = Environ$("computername")
.Offset(0, 7).Value = Environ$("userdomain")
End With
End With
Application.ScreenUpdating = True
End SubHagyj ki alatta egy sort. Válassz az Open helyett BeforeClose-t, majd Workbook_AfterSave-et a kép szerinti legördülőben.
Kaptál két Private Sub - End Sub párost. Ezek közé másold be a fenti makró belsejét (a Private Sub és End Sub közötti részt).
Makróbarátként kell mentened a füzetet.
-
Delila_1
veterán
válasz
karlkani
#29333
üzenetére
A Ctrl+e hozzárendelést külön kell megadnod, mert az általam írtban csak megjegyzésként szerepel.
A füzetben Alt+F8, kiválasztod a makrót, majd az Egyebek gomb segítségével megadod a bill. hozzárendelést. Csak akkor kell, ha Ctrl+... hatására is működésbe akarod hozni.
Érdemes olyan betűt megadni, ami nem alapbeállítása az Excelnek, mint pl. a Ctrl+a, Ctrl+b, stb.
-
Delila_1
veterán
válasz
DeFranco
#29325
üzenetére
Megnyitod a makrót tartalmazó füzetet. Alt+F8-ra megjelennek a makróid. 1-et kiválasztva látod, hogy felül a Makrónév rovat tartalmazza a füzet nevét is.
Ha tehát nincs megnyitva, de az ikonnal indítod, be tudja hívni a makrós füzetet.
Nézz vissza néhány hsz-t, ahol szó van a personalról. Ezt érdemes használni, ha egy makrót több füzetben is alkalmazni akarsz. Javaslom még a Téma összefoglaló erre utaló részének az elolvasását.
-
-
Delila_1
veterán
válasz
Kapanyél
#29317
üzenetére
Nekem is sűrűn van szükségem az érték beillesztésére. Ezért a personalomba tettem egy nyúlfarknyi makrót.
Sub Ertek_beillesztese()
'Billentyűparancs: Ctrl+e
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End SubA makróhoz a Ctrl+e billentyűkódot rendeltem, mint a megjegyzés sorban láthatod.
Működése: kijelölöm a másolandó területet, Ctrl+c-vel másolom, kijelölöm a területet, ahova be akarom illeszteni, Ctrl+e-vel már kész is van.A personalra keress rá itt a fórumon, sokszor volt már szó róla, pl. itt. Ez még a 2007 előtti verzióhoz készült personal.xls leírása, de csak annyi a különbség, hogy a Fejlesztőeszközök | Kód csoport | Makró rögzítése menüponttal kell indulnod, és a létrehozott personal kiterjesztése xlsb lesz.
Az Excel minden indításakor megnyitja a personalt a háttérben, a benne található makrók minden füzetedben alkalmazhatóak.
-
#29315
Delila_1
veterán
m.zmrzlina
#29313
Delila_1
veterán
válasz
m.zmrzlina
#29313
üzenetére
A for-next és a for each-next ciklusnál a program gondoskodik a változó értékének növeléséről (elsőnél esetleg csökkentéséről negatív lépésszámnál), a do-loop-nál neked kell gondoskodni erről.
-
#29312
Delila_1
veterán
m.zmrzlina
#29311
Delila_1
veterán
válasz
m.zmrzlina
#29311
üzenetére
Ilyesmire gondolsz?
sor = 46
Do While Cells(sor, "C") <> ""
If Cells(sor, "D") = "i" Then
Cells(sor, "F") = "aq"
Else
Cells(sor, "F") = "ap"
End If
sor = sor + 1
LoopVagy
sor = 46
Do While Cells(sor, "C") <> ""
Select Case Cells(sor, "D")
Case "e"
Cells(sor, "F") = ""
Case "i"
Cells(sor, "f") = "ap"
Case Else
Cells(sor, "F") = "aq"
End Select
sor = sor + 1
Loop -
Delila_1
veterán
válasz
Reinhardt
#29271
üzenetére
Állítsd be a nyomtatási képen a fekvő lapot, és a margókat. Indíthatod a nyomtatást.
Sub Nyomtat()
Dim lap As Long, sor As Integer, valtozo As Integer
valtozo = 1
For lap = 1 To 50
For sor = 4 To 22 Step 2
Cells(sor, "G") = valtozo
valtozo = valtozo + 1
Next
Range("A1:K23").Select
Selection.PrintOut Copies:=1
Next
End Sub -
#29269
Delila_1
veterán
coldfirexx
#29267
Delila_1
veterán
válasz
coldfirexx
#29267
üzenetére
Az első lap H oszlopában lévő tengerikígyó képlet értéke mikor legyen IGEN, és mikor NEM?
-
#29266
Delila_1
veterán
coldfirexx
#29265
Delila_1
veterán
válasz
coldfirexx
#29265
üzenetére
Tedd ki a füzetet egy elérhető helyre, ahonnan letölthető.
Lehetnek benne hamis adatok az igaziak helyett. Elég pár sor (lásd a Téma összefoglalót). -
#29264
Delila_1
veterán
coldfirexx
#29262
Delila_1
veterán
válasz
coldfirexx
#29262
üzenetére
Átírtad a lapok nevét a makróban szereplő egyes és kettes névről a sajátodra?
If CV = "IGEN" Then Cells(CV.Row, "F").Copy Sheets("kettes").Cells(ide, "A")
A fenti sor kiemelt része végzi a beillesztést.
-
#29261
Delila_1
veterán
irodakukac
#29236
Delila_1
veterán
válasz
irodakukac
#29236
üzenetére
Ny.janos javaslatára megírtam az új makrót.
Az Összes... lapodon jelöld ki a tartományodat. Beszúrás | Táblázat. A neve legyen Összes. A másik lapon a W1-be másold be az első lap H oszlopának a címét, a W2-be írd be: készpénz.
A makró (modulban) ennyi
Sub Spec_Szures()
Sheets("házipénztár").Select
Sheets("Összes könyvelési adat").Range("Összes[#All]").AdvancedFilter Action _
:=xlFilterCopy, CriteriaRange:=Range("W1:W2"), CopyToRange:=Range("A1:T1"), _
Unique:=False
End SubAhányszor indítod ezt a makrót, a házipénztár lapodon mindig a friss, kp-s sorok jelennek meg.
Ha az Összes... lapodra teszel indítógombot, azt is mindig átmásolja, ezért nem érdemes oda tenni. Tedd inkább a másik lapra. -
#29259
Delila_1
veterán
coldfirexx
#29251
Delila_1
veterán
válasz
coldfirexx
#29251
üzenetére
Itt a makró:
Sub Nevek()
Dim usor As Long, ter As Range, ide As Long, CV As Range
usor = Range("H" & Rows.Count).End(xlUp).Row
Set ter = Sheets("egyes").Range("H3:H" & usor).CurrentRegion
For Each CV In ter
ide = Sheets("kettes").Range("A" & Rows.Count).End(xlUp).Row + 1
If CV = "IGEN" Then Cells(CV.Row, "F").Copy Sheets("kettes").Cells(ide, "A")
Next
End SubModulba kell tenned, ahogy a Téma összefoglalóban le van írva.
Szerk.: a válasz elküldése után jutottam az olvasásban oda, hogy kaptál egyszerű, nem makrós megoldást.
-
#29237
Delila_1
veterán
irodakukac
#29236
Delila_1
veterán
válasz
irodakukac
#29236
üzenetére
Szívesen. Nehogy hamar megöregedj!
-
#29235
Delila_1
veterán
irodakukac
#29233
Delila_1
veterán
válasz
irodakukac
#29233
üzenetére
A modulba írtat kiegészítettem azzal, hogy a házipénztár lap előző adatait törölje az új másolás előtt.
Sub Hó_Eleji_KpMásolás()
Dim usor As Long, ter As Range
usor = Range("A" & Rows.Count).End(xlUp).Row
'Előző adatok törlése a házipénztár lapon
Set ter = Sheets("házipénztár").Range("A1").CurrentRegion
ter.Offset(1, 0).Resize(ter.Rows.Count - 1, ter.Columns.Count - 1).ClearContents
'Szűrés készpénzre
ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=8, Criteria1:="készpénz"
'Szűrt sorok másolása
Range("A2:T" & usor).SpecialCells(xlCellTypeVisible).Copy Sheets("házipénztár").Range("A2")
'Szűrés megszüntetése
ActiveSheet.Range("$A$1:$T$" & usor).AutoFilter Field:=8
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Gyermek PC játékok
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- ÁRGARANCIA! Épített KomPhone i5 14400F 32/64GB DDR5 RTX 5060Ti 8GB GAMER PC termékbeszámítással
- Azonnali készpénzes Microsoft XBOX Series S és Series X felvásárlás személyesen/csomagküldéssel
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RTX 5070 GAMER PC termékbeszámítással
- Billentyűzet magyarosítás magyarítás lézerrel is! 10-15ezer közötti áron! Óriási betűkészeletünk van
- 100 - Lenovo Yoga Pro 9 (16IRP8) - Intel Core i9-13905H, RTX 4070 (ELKELT)
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest