- Android alkalmazások - szoftver kibeszélő topik
- CMF Buds Pro 2 - feltekerheted a hangerőt
- iPhone topik
- Samsung Galaxy Watch7 - kötelező kör
- Megjelent a Poco F7, eurós ára is van már
- Telekom mobilszolgáltatások
- One mobilszolgáltatások
- Vivo X200 Pro - a kétszázát!
- Mobil flották
- Okosóra és okoskiegészítő topik
-
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
eszgé100
#50665
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column >= 5 And Target.Column <= 8 And Target.Row = 25 Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, Target.Column))
If Mid(Cells(Target.Row, Target.Column), b, 4) = "True" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, Target.Column), b, 5) = "False" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
Nem emlékszem a módosításra, évekkel ezelőtt volt. Most megnéztem a 33530-as hozzászólásodban belinkelt táblázatot.
A táblázat bővítésének a folyamatát már leírtam.
Az egyes tételek összegzésének két módja is van.
1. A táblázaton állva Táblázattervezés, Táblázatstílusok beállításai, Összegsor bejelölése. Ekkor a táblázat alján megjelenik egy összegző sor. Ha a Tétel oszlopot szűröd, az összegzés csak a látható, szűrt cellákra vonatkozik.
2. Felveszel egy képletet, pl. az E3 cellába:=RÉSZÖSSZEG(9;Kiadás[Összeg]), ezután itt jelenik meg a szűrt, vagy szűretlen sorok összege. -
Delila_1
veterán
válasz
eszgé100
#50643
üzenetére
Az újra színezés előtt vissza kell állítani egységes színűre a cella karaktereit.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column = 5 Then
Application.EnableEvents = False
Cells(Target.Row, 5).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, 5))
If Mid(Cells(Target.Row, 5), b, 4) = "True" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, 5), b, 5) = "False" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
andreas49
#50637
üzenetére
Megírtam, hogy a sok BAL képlet helyére illessze be minden lapon az értékeket. Kisebb lesz a fájl mérete, és gyorsabbak a műveletek.
Sub AR_BAL_1_mod()
Dim ws As Integer
For ws = 1 To Worksheets.Count
Sheets(ws).Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
Sheets(ws).Range("AM4:AQ155").Copy
Sheets(ws).Range("AM4").PasteSpecial xlPasteValues
Sheets(ws).Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
Sheets(ws).Range("AS4:AW155").Copy
Sheets(ws).Range("AS4").PasteSpecial xlPasteValues
Sheets(ws).Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
Sheets(ws).Range("AY4:BC155").Copy
Sheets(ws).Range("AY4").PasteSpecial xlPasteValues
Sheets(ws).Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
Sheets(ws).Range("BE4:BI155").Copy
Sheets(ws).Range("BE4").PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End Sub -
Delila_1
veterán
válasz
andreas49
#50635
üzenetére
Próbáld meg így:
Sub AR_BAL_1_mod()
Dim ws As Integer
For ws = 1 To Worksheets.Count
Sheets(ws).Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
Sheets(ws).Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
Sheets(ws).Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
Sheets(ws).Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
Next
End Sub -
Delila_1
veterán
válasz
Silious
#50625
üzenetére
Indítás előtt érdemes kitörölni az eddig bevitt képeket: Ctrl + g-re előjön az Ugrás menü, Irányított, Objektumok. Ez kijelöli az összes képet, Delete.
Modulba tedd az alábbi makrót, ami az összes, A oszlopban szereplő képnév mellé beteszi a képet a C oszlopba..Sub Kepbeszuras()
Dim utvonal As String, kep As String, sor As Long, usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row
utvonal = "D:\Jpg\" ' itt add meg a saját útvonaladat
For sor = 1 To usor
kep = utvonal & Cells(sor, 1) & ".jpg"
Cells(sor, 3).Select
On Error Resume Next
ActiveSheet.Pictures.Insert(kep).Select
Selection.Left = Cells(sor, 3).Left + 5
Selection.Top = Cells(sor, 3).Top + 5
Selection.Width = 40 'a kép szélessége
Selection.Height = 30 'a kép magassága
On Error GoTo 0
Next
End Sub -
Delila_1
veterán
válasz
eszgé100
#50615
üzenetére
Az E oszlopodra:
Sub Zold_Piros()
Dim sor As Long, usor As Long, kezd As Integer, hossz As Integer
usor = Range("E" & Rows.Count).End(xlUp).Row
For sor = 1 To usor
If Right(Cells(sor, "E"), 4) = "true" Then
hossz = 4
kezd = InStr(Cells(sor, "E"), "true")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 4
Else
hossz = 5
kezd = InStr(Cells(sor, "E"), "false")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 3
End If
Next
End SubLusta voltam a nagybetűre váltást bele venni, majd kiigazítod.
-
Delila_1
veterán
válasz
Silious
#50610
üzenetére
A makrót a lapodhoz rendeld a Téma összefoglaló szerint.
Mikor beírsz az A oszlopba egy nevet, a megadott utvonal mappából betölti a kep nevű képet a C oszlop azonos sorába.
A makró megjegyzései sorában módosíthatsz az útvonalon, kiterjesztésen, és a képek méretein.Private Sub Worksheet_Change(ByVal Target As Range)
Dim utvonal As String, kep As String
If Target.Column = 1 Then
utvonal = "D:\Jpg\" ' itt add meg a saját útvonaladat
kep = utvonal & Target.Value & ".jpg" 'ha nem jpg a kiterjesztés, írd át
Range(Target.Address).Offset(0, 2).Select
On Error Resume Next
ActiveSheet.Pictures.Insert(kep).Select
Selection.Left = Target.Value.Offset(0, 2).Left + 5
Selection.Top = Target.Value.Offset(0, 2).Top + 5
Selection.Width = 40 'a kép szélessége
Selection.Height = 30 'a kép magassága
Range(Target.Address).Select
On Error GoTo 0
End If
End Sub -
Delila_1
veterán
válasz
RockHaRD
#50581
üzenetére
Véletlenül se vond össze a cellákat, mert sok galibát okozhat. Alkalmazz autoszűrőt – megtalálod a leírását a súgóban –, akkor szűrheted a listádat címre, házszámra, bármire. Nem kell sorrendben lenni az adatoknak.
A valós adatok helyére kamu neveket, cégeket írhatsz, mielőtt közszemlére teszel egy képet a füzetedről. Ez most nem jött össze, majd legközelebb. Akkor majd legyenek benne a sorszámok, és oszlopazonosítók is. Például a Képmetszővel lehet jó részleteket kihozni.
A rendezés sajnos úgy marad, ahogy írtad. Ez amiatt van, hogy az Excel a karakterek ASCII kódja szerint rendez, ahol a / (per) kódja kisebb, mint a számoké, ezért kerül előre az emelkedő sorrend előállításakor.
-
#50474
Delila_1
veterán
Lasersailing
#50473
Delila_1
veterán
válasz
Lasersailing
#50473
üzenetére
-
#50472
Delila_1
veterán
Lasersailing
#50470
Delila_1
veterán
válasz
Lasersailing
#50470
üzenetére
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ujszoveg As String
If Len(TextBox1) = 60 Then
ujszoveg = Left(TextBox1, 23) & Mid(TextBox1, 41, 60)
TextBox1.Value = ujszoveg
End If
End Sub -
#50427
Delila_1
veterán
istvankeresz
#50426
Delila_1
veterán
válasz
istvankeresz
#50426
üzenetére
Érdemes rákeresni a cellaformázásokra, sok feladatot meg lehet oldani velük.
-
#50425
Delila_1
veterán
istvankeresz
#50424
Delila_1
veterán
válasz
istvankeresz
#50424
üzenetére
Akkor csak annyi a feladatod, hogy a cellaformátumot írd át.
0,0;; -
#50423
Delila_1
veterán
istvankeresz
#50422
Delila_1
veterán
válasz
istvankeresz
#50422
üzenetére
Azt elfelejtetted megadni, hogy mi legyen a vagy semmi, vagy akármi (SZ, ESZ, MSZ, stb) esetében.
-
#50421
Delila_1
veterán
istvankeresz
#50420
Delila_1
veterán
válasz
istvankeresz
#50420
üzenetére
-
Delila_1
veterán
-
#50378
Delila_1
veterán
istvankeresz
#50377
Delila_1
veterán
válasz
istvankeresz
#50377
üzenetére
Sub Adatok()
Dim ter As Range, CV As Range, szoveg As String
Set ter = Application.InputBox(prompt:="Kérem a tartományt", Type:=8)
For Each CV In ter
szoveg = szoveg & CV & vbLf
Next
MsgBox szoveg
End Sub -
#50357
Delila_1
veterán
Lasersailing
#50351
Delila_1
veterán
válasz
Lasersailing
#50351
üzenetére
Nem tudom mindenre a választ, de feltettem ide egy mintát.
A Bevitel tabon van a Kamu TextBox, aminek a szélessége és magassága is 0 értékű.
Ráállni úgy tudsz, hogy a TextBox1-en TAB-ot nyomsz. -
#50348
Delila_1
veterán
Lasersailing
#50347
Delila_1
veterán
válasz
Lasersailing
#50347
üzenetére
Szia!
Kamu névvel illettem a másik TextBoxot.Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Kamu = TextBox1.Value
'.....
TextBox1 = ""
DoEvents
Cancel = True
End Sub -
Delila_1
veterán
válasz
TheSaint
#50295
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
Application.EnableEvents = False
Visszajelzes Target.Row 'Meghívjuk a másik makrót, átadva a beviteli sor számát
Application.EnableEvents = True
End If
End SubSub Visszajelzes(sor) ' Itt nevet adhatunk a sorszámnak, nem feltétlen Target.Row legyen a változó neve
'...
End Sub -
#50290
Delila_1
veterán
gigabytman
#50289
Delila_1
veterán
válasz
gigabytman
#50289
üzenetére
Szívesen.
-
#50288
Delila_1
veterán
gigabytman
#50287
Delila_1
veterán
válasz
gigabytman
#50287
üzenetére
Azt hiszem, az Ismétlődések eltávolítása funkcióra gondolsz. Ezt az Adatok – Adateszközök menüben találod.
Átmásolod a kérdéses oszlopot egy új helyre, és indítod az ismétlődések eltávolítását. -
#50283
Delila_1
veterán
Lasersailing
#50281
Delila_1
veterán
válasz
Lasersailing
#50281
üzenetére
Szám szöveggé alakítása:
cells(x,y)=cells(x,y) & ""(üres string)
Fordítva:cells(x,y)=cells(x,y)*1 -
Delila_1
veterán
válasz
RAiN91
#50275
üzenetére
A Worksheet_Change eseményt javaslom.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Long
Application.EnableEvents = False
If Target.Address = "$F$4" Then
If Target.Value <> Range("AH9").Value Then
k = Range("AH" & Rows.Count).End(xlUp).Row + 1
Range("AH" & k) = Range("K9").Value
End If
End If
Application.EnableEvents = True
End Sub -
Delila_1
veterán
válasz
RedHarlow
#50224
üzenetére
Úgy látom, minden sorodban szerepel az xyz szövegrész.
A lenti makró az A oszlopban az xyz szöveg után betesz egy sortörést.Sub Sortores()
Dim sor As Integer, b As Integer
sor = 1
Do While Cells(sor, 1) <> ""
b = InStr(Cells(sor, 1), "xyz")
If b > 0 Then Cells(sor, 1) = Left(Cells(sor, 1), b + 2) & Chr(10) & Mid(Cells(sor, 1), b + 3, 100)
sor = sor + 1
Loop
End Sub -
Delila_1
veterán
-
#50173
Delila_1
veterán
Fire/SOUL/CD
#50169
Delila_1
veterán
válasz
Fire/SOUL/CD
#50169
üzenetére
-
Delila_1
veterán
A lenti 3 makrót másold be egy modulba. Az elsőt indítod, az meghívja a másik kettőt.
Törli a Store lapot, majd feldob egy fájlválasztó ablakot.
Indítás előtt a harmadik makróban a Munka2 nevet írd át az Update füzeted másolandó lapja nevére.
Nem kell képletekkel "beszívni" az adatokat, mert az Update füzetből a teljes lapot másoljuk az Original-ba, majd az esetleges képletek helyére értékeket illesztünk be. Ez így gyorsabb, de az összevont cellák miatt mindenféle hiba állna elő nélküle.Option Explicit
Public WB
Sub Store_lap_torlese()
Dim FN
Application.DisplayAlerts = False
On Error Resume Next
Set FN = Sheets("Store")
If Err.Number = 0 Then Sheets("Store").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Fajl_Valasztas
End Sub
Sub Fajl_Valasztas()
Dim b As Integer
Set WB = Application.FileDialog(3)
With WB
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Nem választottál fájlt, befejezzük.", vbInformation, "Értesítés"
Exit Sub
Else
WB = .SelectedItems(1)
End If
End With
For b = Len(WB) To 1 Step -1
If Mid(WB, b, 1) = "\" Then
WB = Mid(WB, b + 1, 50)
Exit For
End If
Next
Sheets("Name").Cells(1) = WB
Workbooks.Open WB
Lapmasolas WB
End Sub
Sub Lapmasolas(WB)
Sheets("Munka2").Copy After:=Workbooks("Original.xlsm").Sheets(2)
Sheets("Munka2").Name = "Store"
Columns("A:Z").Copy
Range("A1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
Workbooks(WB).Close False
Application.DisplayAlerts = True
Sheets("Store").Cells(1).Select
End Sub -
Delila_1
veterán
válasz
Ani Ann
#50069
üzenetére
A sheet-2 lap A1 cellájába beírod
=sheet-1!A1
Ezt másolhatod jobbra, és le.
Ha a 2. lapon nem az 1. lap tükörképét akarod létrehozni, akkor a 2. lap megfelelő cellájába írod a képletet. Pl. a 2. lap D2 cellájában akarod látni az 1. lap A1 cellájának az aktuális értékét, akkor a 2. lap D2-be írod be a fenti képletet. -
Delila_1
veterán
válasz
andreas49
#50045
üzenetére
Kijelölöd a tartományt az alsótól a felsőig. Ctrl+g-re bejön az Ugrás menü. Kiválasztod az Irányított-at, majd az Üres cellák-at. Beírsz valamit, pl. egy pontot, majd Ctrl+Enterrel egyszerre beviszed az összes kijelölt cellába.
Most már nem kell külön nyolcanként a villámkitöltés, egy lépésben elvégezhető.
Szűröd az oszlopot a bevitt pontra, kijelölöd a sorokat, és törlöd a pontot. -
#49993
Delila_1
veterán
the radish
#49992
Delila_1
veterán
válasz
the radish
#49992
üzenetére
Set adatfile = FSO.GetFile("útvonal\fájlnév kiterjesztéssel")
A létrehozás dátumát az adatfile.DateCreated adja meg. -
#49989
Delila_1
veterán
the radish
#49988
Delila_1
veterán
válasz
the radish
#49988
üzenetére
Szívesen.
-
#49987
Delila_1
veterán
the radish
#49986
Delila_1
veterán
válasz
the radish
#49986
üzenetére
Valamit elronthattál, nálam terv szerint működik.
Nem hívja meg esetleg a Makro1 a Makro2-t? -
#49985
Delila_1
veterán
the radish
#49984
Delila_1
veterán
válasz
the radish
#49984
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$1" Then Call Makro1
If Target.Address = "$A$2" Then Call Makro2
Application.EnableEvents = True
End Sub -
Delila_1
veterán
válasz
youngboy
#49970
üzenetére
Túl nagy a tartomány, amiben keresel. A 2007-es verziótól kezdve bő 1 millió sorról van szó.
A helyedben átalakítanám a fájl1-ben a tartományt táblázattá, és ezen belül adnék nevet a kérdéses oszlopnak, a fejléc kivételével. Ha például a táblázat az
A1:G1235tartományt fedi le, és az A oszlopban keresel, azA2:A1235-nek adnám a nevet.
A táblázat növekedése vagy csökkenése automatikusan módosítja az elnevezett tartomány méretét. -
#49863
Delila_1
veterán
istvankeresz
#49862
Delila_1
veterán
válasz
istvankeresz
#49862
üzenetére
Nézz el ide.
-
#49846
Delila_1
veterán
istvankeresz
#49845
Delila_1
veterán
válasz
istvankeresz
#49845
üzenetére
Szívesen.
-
#49844
Delila_1
veterán
istvankeresz
#49843
Delila_1
veterán
válasz
istvankeresz
#49843
üzenetére
Private Sub CommandButton1_Click()
Dim usor As Long
'Itt annak az oszlopnak a betűjelét add meg, amelyikben biztosan ki van töltve az utolsó sorig minden cella
usor = Sheets(ComboBox1.Value).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(ComboBox1.Value).Cells(usor, "A") = TextBox1.Value
Sheets(ComboBox1.Value).Cells(usor, "B") = ComboBox1.Value
End SubAz usor képletének jelentése:
A lapon az A oszlop utolsó celláján állva (Rows.Count) mintha Ctrl+fel nyilat nyomnál, ami az utolsó kitöltött sorra ugrik, ehhez adsz 1-et, hogy az első üres cella sorszámát kapd meg. -
#49842
Delila_1
veterán
istvankeresz
#49841
Delila_1
veterán
válasz
istvankeresz
#49841
üzenetére
Ha nem fontos a lapra lépni, egy cella módosítását 1 lépésben is elintézheted, pl. egy nyomógombhoz rendelve.
Private Sub CommandButton1_Click()
Sheets(ComboBox1.Value).Cells(3, 2) = "asdf"
End Sub -
#49840
Delila_1
veterán
istvankeresz
#49839
Delila_1
veterán
válasz
istvankeresz
#49839
üzenetére
A ComboBox change eseményébe kell tenned a lapra ugrást.
Private Sub ComboBox1_Change()
Sheets(ComboBox1.Value).Select
'Cells(5, 1) = "asdf"
End Sub -
Delila_1
veterán
válasz
rvn_10
#49827
üzenetére
Szívesen.
Olyan adatot is láttam – már nem emléxem, melyiket, de talán az Inform lap B oszlopában volt –, ami kétszer is szerepelt, két saját cikkszámodhoz rendelve.
Érdemes lenne egy új oszlopban a DARABTELI (Countif) függvénnyel megnézetni oszloponként az ismétlődéseket. -
Delila_1
veterán
válasz
rvn_10
#49824
üzenetére
A saját magyar Excelemben sikerült megoldanom.
Az E2 cella képlete (amit majd kiegészítesz):
=KARAKTER(64+HA(DARABTELI('Infor számok'!B:B;$A2)>0;2;0)+HA(DARABTELI('Infor számok'!C:C;$A2)>0;3;0)+HA(DARABTELI('Infor számok'!D:D;$A2)>0;4;0)+HA(DARABTELI('Infor számok'!E:E;$A2)>0;5;0)+HA(DARABTELI('Infor számok'!F:F;$A2)>0;6;0)+HA(DARABTELI('Infor számok'!G:G;$A2)>0;7;0)+HA(DARABTELI('Infor számok'!H:H;$A2)>0;8;0))Így csak 1 segédoszlop kell a Rendáll lapon.
Feltettem ide.
Új hozzászólás Aktív témák
Hirdetés
- Vezetékes FEJhallgatók
- Miskolc és környéke adok-veszek-beszélgetek
- Óvodások homokozója
- A nagy Szóda, Szódakészítés topic - legyen egy kis fröccs is! :-)
- Kecskemét és környéke adok-veszek-beszélgetek
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Revolut
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- 3D nyomtatás
- 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
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- AKCIÓ! ASUS STRIX B650E-E R7 7700 64GB DDR5 1TB SSD RTX 3080 10GB Thermaltake Ceres 500 850W
- BESZÁMÍTÁS! Gigabyte A620M R5 7500F 32GB DDR5 512GB SSD RTX3070 8GB ZALMAN S2 TG Enermax 750W
- Bomba ár! Lenovo ThinkBook 14s Yoga - i5-1135G7 I 16GB I 256SSD I 14" FHD Touch I Cam I W11 I Gari
- HP Probook 650 G4 15,6 i5-8350u 8. gen. GYÁRI MAGYAR VILÁGÍTÓ BILL!!!
- LG 65C4 - 65" OLED evo - 4K 144Hz - 0.1ms - NVIDIA G-Sync - FreeSync - HDMI 2.1 - 1000 Nits
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest