Hirdetés
- sparks: 15 év droid után iPhone tapasztalat, 7 nap alatt
- Brogyi: CTEK akkumulátor töltő és másolatai
- Meggyi001: Kuponok....
- Szevam: Mennyire tipik Z-gen viselkedés? Tipizálható-e egyáltalán?
- sziku69: Fűzzük össze a szavakat :)
- lezso6: Miért is jó, ha dohányzol?! Megéri rászokni!
- ldave: New Game Blitz - 2025
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- Luck Dragon: Asszociációs játék. :)
-
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
wednesday
#39661
üzenetére
Sub LapMasolas()
Dim lookup_name As String, lookup_date As Date
lookup_name = "ÚjLapNeve" 'Cellahivatkozás is adhatsz nevet-> lookup_name = Range("A3")
lookup_date = Date 'Mai dátum. Cellahivatkozással-> lookup_date =Range("C10")
Sheets(1).Copy Before:=Sheets(2)
'A lap másolása után az új lap lesz aktív
ActiveSheet.Name = lookup_name & "_" & Format(lookup_date, "YYYYMMDD")
'Ha a fenti, megjegyzések szerinti hivatkozás alapján akarsz nevet adni, az ActiveSheet.Name kezdetű
'sor helyett legyen ActiveSheet.Name = Range("A3") & "_" & Format(Range("C10"), "YYYYMMDD")
'Az új lap D8 és D15 cellájából törli az értékeket
Range("D8,D15") = ""
End Sub -
wednesday
őstag
-
Mutt
senior tag
válasz
wednesday
#39624
üzenetére
Szia,
Felraktam ide egy változatot, amely tudja azokat a dolgokat amiket kértél.
Plusz dolog a részemről, hogy tettem adatvalidációt az űrlapon a név és dátum mezőkre, mert simán lehet hogy vki olyan komibinációt választ amihez nincs adat. Ha vki választ egy nevet, akkor VBA kikeresi hogy mely dátumok valósak hozzá. Ez fordítva is igaz, vagyis dátum alapján leszűkíti a VBA a neveket is.
Ha új keresést akar vki, akkor át kell váltani egy másik lapra és visszajönni az űrlapra.üdv
-
Delila_1
veterán
válasz
wednesday
#39628
üzenetére
Private Sub CommandButton1_Click()
Dim sor As Variant
On Error Resume Next
sor = Sheets(1).Range("A:A").Find(CDate(TextBox1)).Row
If IsEmpty(sor) Then
MsgBox "Nem található " & TextBox1 & " dátum az A oszlopban.", vbCritical
On Error GoTo 0
Exit Sub
Else: MsgBox sor
End If
End Sub -
lappy
őstag
válasz
wednesday
#39624
üzenetére
itt van a fájlból a két makró
Private Sub CommandButton1_Click()
b = 1
For a = 9 To 15
If Worksheets("Munka1").Cells(a, 2).Value = TextBox1.Value And Worksheets("Munka1").Cells(a, 3).Value = ComboBox1.Value Then
Worksheets("Munka2").Cells(b, 2).Value = Worksheets("Munka1").Cells(a, 2).Value
Worksheets("Munka2").Cells(b, 3).Value = Worksheets("Munka1").Cells(a, 3).Value
Worksheets("Munka2").Cells(b, 4).Value = Worksheets("Munka1").Cells(a, 4).Value
Worksheets("Munka2").Cells(b, 5).Value = Worksheets("Munka1").Cells(a, 5).Value
Worksheets("Munka2").Cells(b, 6).Value = Worksheets("Munka1").Cells(a, 6).Value
Worksheets("Munka2").Cells(b, 7).Value = Worksheets("Munka1").Cells(a, 7).Value
b = b + 1
End If
Next a
End SubThisWorkbook
Private Sub Workbook_Open()
Munka1.ComboBox1.AddItem "készpénz"
Munka1.ComboBox1.AddItem "utalvány"
Munka1.ComboBox1.AddItem "kártya"
End Sub -
wednesday
őstag
válasz
wednesday
#39623
üzenetére
Na találtam a neten egy egész használható megoldást. Csak a feladathoz kéne igazítanom. Viszont megnyitva nem látom a makrót.
Én is két adat alapján tudnék keresni. Név meg dátum szerint, és hozzá tartalmazó adatokat kéne átmásolnom a megfelelő helyre. A kikeresés után az átmásolandó adatok nem fixek, hanem addig tartanak, ahol a következő név és dátum kezdődik az én példámba. Ezeket az adatokat kéne meghatározott cellákba másolni, azzal a különbséggel, hogy magát a nevet és dátumot (csop. vezetőt és fizetési módot) is másolni kéne.
-
Mutt
senior tag
válasz
wednesday
#39417
üzenetére
Szia,
Itt van mutatott mintához a makró. A kommentek alapján tudod finomítani.
Sub Mentes()
Const urlap_helye = "Urlap" 'munkalap neve ahol van az űrlap
Const mentes_helye = "Mentes" 'munkalap neve ahova menteni kellene
Dim utolsoSor As Long, i As Long
Dim wsForras As Worksheet
Dim wsMentes As Worksheet
Set wsForras = ThisWorkbook.Sheets(urlap_helye)
Set wsMentes = ThisWorkbook.Sheets(mentes_helye)
With wsMentes
utolsoSor = .Range("A" & Rows.Count).End(xlUp).Row + 1 'megkeressük az első szabadsort a mentés lapon
For i = 17 To 35 'az űrlap 17-35 sora között nézzük a felírásokat
If Len(.Cells(i, "C")) > 0 Then
.Cells(utolsoSor, "A") = Now 'A-oszlopba rögzíjük a mentés dátumát
.Cells(utolsoSor, "B") = wsForras.Range("D7") 'B-oszlopba jön az első sorban lévő D-L egyesített cella tartalma
.Cells(utolsoSor, "C") = wsForras.Range("B" & i) 'C-oszlopba jön a B-oszlopbeli sorszám
.Cells(utolsoSor, "D") = wsForras.Range("C" & i) 'D-oszlopba a C-H tartalma
.Cells(utolsoSor, "E") = wsForras.Range("J" & i) 'E-oszlopba a J tartalma
.Cells(utolsoSor, "F") = wsForras.Range("K" & i) 'F-oszlopba a K tartalma
If .Cells(i, "C").MergeCells Then 'ha összevont cellákról van szó, akkor át kell ugornunk az összevont sorokat
i = i + .Cells(i, "C").MergeArea.Rows.Count - 1
End If
utolsoSor = utolsoSor + 1
End If
Next i
End With
Set wsForras = Nothing
Set wsMentes = Nothing
End Subüdv
-
lappy
őstag
-
Mutt
senior tag
válasz
wednesday
#39388
üzenetére
..az űrlapon 6 sor adat van vagy éppen 3 akkor, azokat pakolja át a mentési táblába.
Tudsz mutatni egy mintát hogyan néz ki egy többsoros űrlap nálad?
A legördülő listánál ActiveX-es elem tud segíteni. Talán ezt a megoldást https://trumpexcel.com/excel-drop-down-list-with-search-suggestions/ tudom javasolni.
-
Delila_1
veterán
válasz
wednesday
#39390
üzenetére
Tervező módban az egérrel könnyedén állíthatod a vezérlő méreteit, de a tulajdonságoknál pontosan is megadhatod a szélességét a Width mezőben.
Nem tudok róla, hogy kulcsszavakra lehetne keresni benne.
Az egyszerre látható sorok számát a ListRows opciónál állíthatod be. Ez alapértelmezés szerint 8, de ha nagyobb értéket adsz neki, több sort mutat, könnyebb a választás a hosszú szövegek közül.
-
Delila_1
veterán
válasz
wednesday
#39388
üzenetére
Érvényesítés helyett használj ActiveX vezérlőt.
Fejlesztőelemek > Vezérlők > Beszúrás > ActiveX vezérlők > Beviteli lista
Tervező módban legyél, a tulajdonságoknál a ListFillRange helyen adhatod meg a bevitel helyét, pl. A1:A50.
Kikapcsolva a tervező módot már működik is a kezdőbetűre ugrás. -
Mutt
senior tag
válasz
wednesday
#39378
üzenetére
Szia,
A leírásod alapján vmi ilyen struktúrában van az űrlapod.
Kitettem mellé egy Mentés nevezetű gombot, amihez rendelheted ezt a makrót:
Sub Mentes()
Const urlap_helye = "Urlap" 'munkalap neve ahol van az űrlap
Const mentes_helye = "Mentes" 'munkalap neve ahova menteni kellene
Dim utolsoSor As Long
Dim wsForras As Worksheet
Dim wsMentes As Worksheet
Set wsForras = ThisWorkbook.Sheets(urlap_helye)
Set wsMentes = ThisWorkbook.Sheets(mentes_helye)
With wsMentes
utolsoSor = .Range("A" & Rows.Count).End(xlUp).Row + 1 'megkeressük az első szabadsort a mentés lapon
.Cells(utolsoSor, "A") = Now 'A-oszlopba rögzíjük a mentés dátumát
.Cells(utolsoSor, "B") = wsForras.Range("D1") 'B-oszlopba jön az első sorban lévő D-L egyesített cella tartalma
.Cells(utolsoSor, "C") = wsForras.Range("A2") 'C-oszlopba az A2-es cella tartalma
.Cells(utolsoSor, "D") = wsForras.Range("C2") 'D-oszlopba a C-H tartalma
.Cells(utolsoSor, "E") = wsForras.Range("J2") 'E-oszlopba a J2 tartalma
.Cells(utolsoSor, "F") = wsForras.Range("K2") 'F-oszlopba a K2 tartalma
End With
End SubRemélem a bent lévő kommentek alapján át tudod írni/pontosítani, hogy honnan és hova mentsen a makró.
üdv
-
wednesday
őstag
válasz
wednesday
#39378
üzenetére
Most makro rögzítése paranccsal próbálkozom amatőr módon.
A másolás lefut, eddig oké. Azt kéne kinéznem, hogy mindig csak azokat a cellákat emelje át, amibe adatok vannak. És a másik táblázatba mindig csak üres sorokba és oszlopokba tegye az adatokat szépen egymás alá, összegyűjtve őket.
-
Delila_1
veterán
válasz
wednesday
#38868
üzenetére
A sok jelölőnégyzet jócskán megnöveli a fájl méretét. Alkalmazd a lappy által javasolt x-et, vagy van lehetőség a pipa beírására is.
Az oszlopot, ahova a pipát akarod tenni, Wingdings, félkövér karakterre állítsd, és mikor kész a sor, egy ü betűt írj ide.
Nekem a personalban (lásd a Téma összefoglalót) van egy nyúlfarknyi makróm, amihez a gyorselérési eszköztárra kitettem egy ikont. Ott – csodák csodája – a módosításnál rendelhettem hozzá egy pipa alakú ikont. A cellán állva rákattintok az ikonra, mire betesz egy kék pipát a kiválasztott cellába.
Sub Pipa()
ActiveCell = "ü"
With Selection.Font
.Name = "Wingdings"
.Bold = True
.ColorIndex = 5
End With
End SubA colorindexet 3-ra állítva piros lesz a pipa színe.
Új hozzászólás Aktív témák
Fferi50- Gumi és felni topik
- TP-LINK routerek
- PlayStation 5
- Mobil flották
- Megérkeztek a Xiaomi 15T sorozatának telefonjai Magyarországra
- Android alkalmazások - szoftver kibeszélő topik
- sparks: 15 év droid után iPhone tapasztalat, 7 nap alatt
- Építő/felújító topik
- E-book olvasók
- A fociról könnyedén, egy baráti társaságban
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Eladó Steam kulcsok kedvező áron!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- ÁRGARANCIA! Épített KomPhone i5 13400F 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
- Huawei Watch GT 5 // Számla+Garancia //
- HP 200W (19.5V 10.3A) kis kék, kerek, 4.5x3.0mm töltők + tápkábel, 928429-002
- Dell Precision 5820 XL PC - Xeon W-2123 112GB RAM 512GB SSD 1TB HDD RX 580 GTS 8GB Win 11
- Bomba ár! Microsoft Surface Pro 7+ LTE - i5-11GEN I 8GB I 256SSD I W11 I Cam I Garancia!
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest