-
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
-
Delila_1
veterán
válasz
föccer #35928 üzenetére
Dim a
On Error Resume Next
Set a = Sheets(Range("C2"))
If Err.Number <> 0 Then
Sheets.Add.Name = Range("C2")
On Error GoTo 0
End If
Columns("A:D").ColumnWidth = 20Az alsó sor az A:D oszlopok szélességét állítja be, és teszi ezt az újonnan létrehozott lapon, mert hivatalból az új lap az aktív. Ha másik lapon akarod a szélességet beállítani, akkor ezt jelezni kell.
Sheets(1).Columns("A:D").ColumnWidth = 20
-
Delila_1
veterán
-
Delila_1
veterán
válasz
föccer #35879 üzenetére
Rossz hírem van. A másolandó tartománynak először a formátumát másolom a másik lapra, hogy azonosak legyenek a cellaegyesítések. Ennek ellenére az azonos formátumú másolandó területet nem képes az Excel beilleszteni. A lenti makróban kihagyhatod a csillagokkal jelzett sort, mert ott megbukik. Meg kell szüntetned az egyesítéseket, akkor jó lesz.
Sub Masolas()
Dim sor As Long
If Sheets(2).Range("A5") = "" Then
sor = 5
Else
sor = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 2
End If
Sheets(1).Range("AD18:AD21").Copy
Sheets(2).Range("A" & sor).PasteSpecial xlPasteFormats '***
Sheets(2).Range("A" & sor).PasteSpecial xlPasteValues
End Sub -
Delila_1
veterán
válasz
föccer #35863 üzenetére
Szűrés után futtathatod a modulba másolt makrót.
Sub sorszam()
Dim sor As Long, oszlop As Integer
For sor = 23 To 1000
If Rows(sor).Hidden = False Then
For oszlop = 1 To 5
Cells(1, oszlop) = Cells(sor, oszlop)
Next
For oszlop = 15 To 24
Cells(1, oszlop) = Cells(sor, oszlop)
Next
Exit Sub
End If
Next
End Sub -
Delila_1
veterán
válasz
sinkoati85 #35847 üzenetére
Ez egy ListBox. Jobb klikk rajta, Delete.
-
Delila_1
veterán
válasz
Mela Kehes #35835 üzenetére
Kimutatást kell készítened pár kattintással. Ebben az oszlopodat, ami a sikerült - nem sikerült értékeket mutatja, szűrd a "sikerült"-re.
-
Delila_1
veterán
válasz
Mela Kehes #35813 üzenetére
Ha a nevet tartalmazó oszlop jobbra van a keresett értéktől, akkor az FKERES is alkalmazható.
-
Delila_1
veterán
válasz
lenkei83 #35810 üzenetére
Másik megoldás (Feriéhez képest): tedd keretbe a CheckBoxokat, és egy gombhoz rendeld a lekérdezést.
Private Sub CommandButton1_Click()
Dim i As Object, f As Boolean
For Each i In Frame1.Controls
If i = False Then f = True
Next
If f Then MsgBox "Nincs minden jejölőnégyzet bejelölve", vbInformation
End Sub -
Delila_1
veterán
válasz
Mela Kehes #35808 üzenetére
INDEX és HOL.VAN.
-
Delila_1
veterán
válasz
NemszakiTomi #35733 üzenetére
Nézd meg a cellaformátumot is! Van egy formátum – ;;; –, ami láthatatlanná teszi a cella tartalmát.
-
Delila_1
veterán
válasz
Acustic #35720 üzenetére
Szia Attila!
Az első makrót a laphoz kell rendelned. Mikor a H oszlopba beírsz, vagy bemásolsz egy nevet, akkor ez a cella, valamint az A oszlopban lévő, azonos tartalmú cellák háttere sárga lesz. Az első, A oszlopban lévő név cellája lesz kijelölt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range, CV As Object
If Target.Column = 8 Then
Set ter = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each CV In ter
If CV = Target Then
CV.Interior.Color = vbYellow
CV.HorizontalAlignment = xlRight
CV.VerticalAlignment = xlTop
End If
Next
Range(Target.Address).Interior.Color = vbYellow
Range(Target.Address).HorizontalAlignment = xlRight
Range(Target.Address).VerticalAlignment = xlTop
Range("A" & Application.WorksheetFunction.Match(Target, Columns(1), 0)).Select
End If
End SubA második makró modulba kerül. Ehhez rendelj billentyű kombinációt, aminek hatására indul a makró. Az aktuális cella háttere piros lesz, a kijelölés a következő, ilyen nevet tartalmazó cellára ugrik az A oszlopban. Mikor a kombinációval befejezted a szereplőhöz tartozó összes cella átszínezését, a H oszlopban is pirosra vált a név cellája, ez lesz kijelölt. Üzenetet kapsz, hogy a szereplő összes sora kész van.
Sub Piros()
Dim sor, nev As String
If Selection.Column = 1 Then
nev = Selection.Value
On Error GoTo KeszVan
sor = Range("A" & Selection.Row + 1 & ":A10000").Find(nev).Row
Selection.Interior.Color = vbRed
Selection.HorizontalAlignment = xlLeft
Cells(sor, "A").Select
End If
Exit Sub
KeszVan:
Selection.Interior.Color = vbRed
Selection.HorizontalAlignment = xlLeft
sor = Columns(8).Find(nev).Row
Cells(sor, "H").Interior.Color = vbRed
Cells(sor, "H").HorizontalAlignment = xlLeft
Cells(sor, "H").Select
MsgBox nev & " minden sora kész van.", vbInformation, "Értesítés"
End SubJó munkát! Üdv
Kati -
Delila_1
veterán
válasz
Acustic #35716 üzenetére
Ha jól értem, a H oszlopba írod be az aktuális szereplő nevét. Ekkor az A oszlopban lévő, ilyen nevű szereplőt tartalmazó cellák váljanak sárga hátterűvé, felül jobbra rendezetté. Mikor új nevet adsz meg a H oszlopban, az előbbi cellák legyenek piros hátterűek, felül balra rendezettek, és az újonnan megadott név cellái sárgák, felül jobbra rendezettek.
A laphoz rendeld a makrót (lásd a téma összefoglalóban).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range, CV As Object
If Target.Column = 8 Then
Set ter = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each CV In ter
If CV.Interior.Color = vbYellow Then
CV.Interior.Color = vbRed
CV.HorizontalAlignment = xlLeft
CV.VerticalAlignment = xlTop
End If
If CV = Target Then
CV.Interior.Color = vbYellow
CV.HorizontalAlignment = xlRight
CV.VerticalAlignment = xlTop
End If
Next
End If
End SubRemélem, így gondoltad. Ha nem, akkor vagy segít valaki, vagy délután én átírom a makrót.
-
Delila_1
veterán
válasz
Carasc0 #35682 üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [I16:I35]) Is Nothing Then
If Target >= 3 And Target < 5 Then
Cells(Target.Row, "AZ") = "I"
Cells(Target.Row, "AZ").Locked = True
End If
If Target >= 5 Then
Cells(Target.Row, "BE") = "I"
Cells(Target.Row, "BE").Locked = True
End If
End If
End Sub -
Delila_1
veterán
válasz
Carasc0 #35680 üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '****
If Not Intersect(Target, [I16:I35]) Is Nothing Then
If Target >= 3 Then
Cells(Target.Row, "AZ") = "I"
Cells(Target.Row, "AZ").Locked = True
End If
End If
End Sub -
Delila_1
veterán
válasz
Carasc0 #35675 üzenetére
Az AZ16 eleve legyen zárolt, az I16 pedig nem.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '**********
If Target.Address = "$I$16" And Target >= 3 Then
Range("AZ16") = "I"
Range("$I$16").Locked = True
End If
End Sub -
Delila_1
veterán
válasz
Carasc0 #35669 üzenetére
Ez a makró akkor fut le, ha a lapon bármelyik cellába billentyűzetről viszel be adatot. Mivel nem az A1-be pötyögtetsz, azt a cellát kell figyeltetni, amelyiknek az értékétől függően az A1 ilyen, vagy olyan értéket vehet fel.
Add meg konkrétan, melyik cellákat módosítod, és ezeknek a hatására melyik tartomány módosul. Továbbá, hogy milyen érték(ek)nél kell zárolni a tartományt.
-
Delila_1
veterán
válasz
Carasc0 #35665 üzenetére
Vedd le a zárolást az A1 celláról, meg a többiről, amikbe írhat a felhasználó.
Rendeld a laphoz a lenti makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Gólyacsőr" Then '***********
Range("A1").Locked = True
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '************
End If
End If
End SubA csillagokkal jelzett sorokon kell változtatnod. Az elsőben a "Gólyacsőr" helyére azt írd be, aminek a bevitele után nem akarod engedni az A1 módosítását, a másodikban az "aaa" helyén legyen a saját lapvédelmed jelszava.
-
-
Delila_1
veterán
Nem az a baj, hanem az, hogy nem vettem figyelembe a sortörlések alapszabályát. Eszerint a törlési ciklust az alsó sortól felfelé kell indítani.
Sub Torles()
Dim sor As Long, usor As Long
Application.ScreenUpdating = False
usor = Range("A" & Rows.cunt).End(xlUp).Row
For sor = usor To 2 Step -1
If Cells(sor, "J") = "-" And Cells(sor, "G") <> "Alma*" And _
Cells(sor, "G") <> "Körte*" And Cells(sor, "G") <> "Narancs*" Then _
Rows(sor).Delete Shift:=xlUp
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
Próbáld ki ezt:
Sub mm()
Dim sor As Long, usor As Long, WF As WorksheetFunction
Dim ter As Range, CV As Range
Set WF = Application.WorksheetFunction
If WF.CountIf(Columns(7), "Alma*") + WF.CountIf(Columns(7), "Körte*") _
+ WF.CountIf(Columns(7), "Narancs*") > 0 Then
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$1:$K$" & usor).AutoFilter Field:=10, Criteria1:="-"
usor = Range("J" & Rows.Count).End(xlUp).Row
Set ter = Range("G2:G" & usor).SpecialCells(xlCellTypeVisible)
For Each CV In ter
If CV <> "Alma*" And CV <> "Körte*" And CV <> "Narancs*" Then _
Rows(CV.Row).Delete Shift:=xlUp
Next
usor = Range("J" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$1:$K$" & usor).AutoFilter Field:=10
End If
End Sub -
Delila_1
veterán
válasz
JagdPanther #35625 üzenetére
Örülök, hogy sikerült, szívesen.
-
Delila_1
veterán
válasz
JagdPanther #35622 üzenetére
Töröld a laphoz rendelt makrót, a modulban lévőt írd át.
Sub Masol()
Dim sor As Long
sor = Selection.Row
With Sheets("Számla")
.Range("B12") = Cells(sor, "E")
.Range("B28") = Cells(sor, "F")
.Range("H12") = Cells(sor, "J")
.Range("D10") = Cells(sor, "N")
End With
End SubA füzetben a Makrók menüben (Alt + F8), a Masol makrót kiválasztva az Egyebek almenüben bill. kombinációt rendelhetsz hozzá.
-
Delila_1
veterán
válasz
JagdPanther #35619 üzenetére
Az Ebay laphoz rendeltem egy makrót.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Masol Target.Row
Cancel = True
End SubModulba jön a másik.
Sub Masol(sor)
With Sheets("Számla")
.Range("B12") = Cells(sor, "E")
.Range("B28") = Cells(sor, "F")
.Range("H12") = Cells(sor, "J")
.Range("D10") = Cells(sor, "N")
End With
End SubAz Ebay lapon egy sor valamelyik celláján jobb klikk, indul az eseményvezérelt makró, majd indítja a másolást.
Rendelheted más eseményhez is. -
Delila_1
veterán
válasz
Pulsar #35618 üzenetére
Feltöltöttem egy fájlt.
A Munka1 lapon az eredeti elrendezésben van a táblázatod. Itt egy elég összetett képlettel sikerült összehozni a műszakok jelét, de csak a hónap 21. napjáig, mert onnan kezdve az oszlopoknak 2 karakterből áll a betűjele. Ki lehetett volna bővíteni a képletet, de minek.A Munka2 lapon transzponáltam a táblázatodat, így már rövidebb képlettel sikerül elérni az eredményt.
-
Delila_1
veterán
válasz
Pulsar #35616 üzenetére
Csak a nappalos műszak elejét és végét adtad meg, ami 12 órát foglal magában. A közölt képen is N és É van, az A; B; C és D betűket nem tudtam mire vélni.
Nálatok egy nap 48 óra?Az előzőek szerint már össze tudod állítani a táblázatodat. Ha nagyon nem megy, itt valószínűleg kapsz segítséget.
-
Delila_1
veterán
válasz
Pulsar #35614 üzenetére
Az E oszlopba betettem a nevezetes időpontokat. Ezek vannak a G oszlopban is, de már általános formátumban (G1-> =E1). A G1:G6 tartományt érdemes saját magára értékként beilleszteni, akkor az E1:E6 feleslegessé válik, törölhető. A B oszlop képlete a G1:H6 tartományra hivatkozik, mikor itt keresi az A oszlopból képzett időpontot. A G:H tartományt teheted máshova is.
A B1 cella képlete lehet az INDEXes helyett
=FKERES(IDŐ(ÓRA(A1);PERC(A1);0);$G$1:$H$6;2)
-
Delila_1
veterán
válasz
maestro87 #35604 üzenetére
Ezért írtam a "gyalogos" képletet.
Megoldhatod csoportba foglalással is, csak ott az A oszlopban azonos adatoknak kell lenniük az összegzendő B számok mellett. Ilyenkor a Részösszeg beszúrásakor vedd ki a pipát az "Összeg az adatok alatt" opció elől.
Hátránya, hogy 2× szerepel majd az összeg, 1× végösszegként, 1× meg mint a csoport összege.Szerk.:
Másik hátrány, hogy új sor felvitelekor újra kell kezdeni a csoportosítást. -
Delila_1
veterán
A refedit rákattintáskor a benne kijelölt területet teszi be egy string típusú változóba, amit kiértékelhetsz. Példa:
Private Sub CommandButton1_Click()
If Range(RefEdit1) < 10 Then
MsgBox "10-nél nagyobb számot tartalmazó cellát kell választanod!", vbExclamation
RefEdit1 = ""
RefEdit1.SetFocus
End If
End Sub -
Delila_1
veterán
válasz
kacsaesokos #35461 üzenetére
Nincs mit, szívesen.
-
Delila_1
veterán
válasz
kacsaesokos #35458 üzenetére
Azért nem jön össze, mert a költséghelyek lapon a adatok végén szóközök vannak.
A TRIM függvénnyel levághatod egy segédoszlopban, majd a megtisztított adatokat értékként beillesztheted az eredeti helyre, a C oszlopba.
-
Delila_1
veterán
válasz
aclandiae #35430 üzenetére
D. Kijelölöd a tartományt (egy tetszőleges cellára állsz a táblázatodban, Ctrl+a, vagy Ctrl+t). Behozod a Ugrás menüt a Ctrl+g-vel, Irányított, Állandók.
E. Ha már bekapcsoltad az Autoszűrőt, a méret legördülőjén klikk. A felsorolásnál kiveszed a pipát az összes kijelölése elől, és kiválasztod a látni kívánt tételt.
C. A nullákat (látszólag) másképp is eltüntetheted. Az Excel beállításainál Speciális, Beállítások megjelenítése ehhez a munkalaphoz, majd kiveszed a pipát a Nulla megjelenítése a nulla értékű cellákban négyzet elől.
-
Delila_1
veterán
válasz
Juditta_56 #35405 üzenetére
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Mikor ezeket elhagyod, az xlPasteValues elé sem kell kiírnod a Paste:= -t.
-
Delila_1
veterán
válasz
Juditta_56 #35405 üzenetére
Eleinte én is így adtam meg, de egy másik fórumon felvilágosítottak.
-
Delila_1
veterán
válasz
Juditta_56 #35403 üzenetére
A helyfoglalásnál minden változóhoz meg kell adnod a típust, másképp Variant lesz, ami több helyet foglal a memóriában.
Dim EllSor As Integer, EllOszl As Integer, JelSor As Integer, HibaOszl As Integer
Szerk.:
Az eredeti specbeillesztésnél néhány olyan paraméter szerepelt, ami alapértelmezés, azokat elhagyhatjuk. -
Delila_1
veterán
válasz
Juditta_56 #35397 üzenetére
A Range a hiba. Vedd ki, a hozzá tartozó zárójelekkel együtt.
A Range utasítás szöveges értéket vár, pl. "A1". A Cells(sor, oszlop) viszont 2 számot ad, ezt nem veszi be a Range.
-
Delila_1
veterán
válasz
Juditta_56 #35395 üzenetére
Próbáld így:
Workbooks(ControlNeve).Sheets(osszlap).Cells(EllSor + 24, HibaOszl).PasteSpecial xlPasteValues
Új hozzászólás Aktív témák
Hirdetés
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- 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 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- BESZÁMÍTÁS! Lenovo ThinkPad T14 Gen 4 üzleti notebook - i7 1360P 24GB DDR5 RAM 512GB SSD Iris Xe W11
- IKEA Format lámpák eladóak (Egyben kedvezménnyel vihető!)
- AKCIÓ! Apple iPad Pro 11 2024 1TB WiFi + Cellular tablet garanciával hibátlan működéssel
- Xiaomi Redmi 12 Pro 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7600X 16/32/64GB RAM RX 7700XT 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged