Hirdetés
- Bemutatkozott az Oppo kamerás csúcsmodellje
- Google Pixel 10 Pro XL – tíz kicsi Pixel
- VoLTE/VoWiFi
- iPhone topik
- Xiaomi 15T Pro - a téma nincs lezárva
- Egy picit megpihen az iPhone a 200 megapixeles váltás előtt
- Xiaomi 17 Ultra - jó az optikája
- Xiaomi 14T - nem baj, hogy nem Pro
- Samsung Galaxy A52s 5G - jó S-tehetség
- Nothing Phone 2a - semmi nem drága
-
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
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
Hirdetés
Fferi50- Bemutatkozott az Oppo kamerás csúcsmodellje
- LCD, plazma és projektoros TV-k hibái
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- Google Pixel 10 Pro XL – tíz kicsi Pixel
- Mikrotik routerek
- Vicces képek
- VoLTE/VoWiFi
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- Canon MILC: EOS R és M topik
- iPhone topik
- További aktív témák...
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Microsoft és egyéb dobozos és OEM szoftverek
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- ELADÓ FÓLIÁZOTT HP EliteBook 840 G9 i7-1265U 16GB 512GB 14" FHD+ 1 év teljeskörű garancia
- ÁRGARANCIA! Épített KomPhone R7 5700X 16/32/64GB RAM RX 9060 XT 16GB GAMER PC termékbeszámítással
- Apple iPhone 15 128 GB Black 1 év Garancia Beszámítás Házhozszállítás
- iPhone 13 Pro 128GB 100% (1év Garancia) - ÚJ EREDETI AKKUMULÁTOR
- SK Hynix, Samsung és más 16GB DDR4 so dimm 3200MHz modulok számlával, 6 hó garanciával
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest