- 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
zannor
#15321
üzenetére
Ennél rosszabb példát fel sem lehetett volna adni. Ilyenkor szoktuk visszadobni a listát azzal, hogy ha normális eredményeket várnak, akkor tisztességesen adják meg a kiinduló adatokat.
Olyan veszedelmes képletekkel lehet helyrehozni a táblázatot, hogy inkább levélben küldeném el a megoldást – feltéve, hogy megadod az elérhetőségedet privátban.
-
Delila_1
veterán
válasz
zannor
#15318
üzenetére
Eljutottál a FKERES-ig, de megállt a tudomány. Akkor azt a részt megoldottad, vagy nem?
A feltételeket hibásan adták meg, az első és a harmadik üti egymást. A harmadik valószínűleg 2700-3883 akart lenni. A kérdés feltevője lehet trehány, a választ adó nem.
![;]](//cdn.rios.hu/dl/s/v1.gif)
A szűrésnél találsz olyan opciót, hogy a vége. Ennél megadod pl. a Kft-t, VAGY operátorral pedig a kft-t.
-
#15267
Delila_1
veterán
Fire/SOUL/CD
#15266
Delila_1
veterán
válasz
Fire/SOUL/CD
#15266
üzenetére
Egy kicsit variálva minden hibás címet kiír.
Sub valami()
Dim MyRange As Range
Dim MyCell As Range
Dim MyRow
Set MyRange = Range("C1:C100")
MyRow = 1
For Each MyCell In MyRange
If Application.WorksheetFunction.IsError(MyCell) Then
Range("M" & MyRow) = MyCell.Address
MyRow = MyRow + 1
End If
Next
End Sub -
-
#15248
Delila_1
veterán
medvezsolt
#15247
Delila_1
veterán
válasz
medvezsolt
#15247
üzenetére
Akkor most kezdd el lassan az elejétől.
Hova írod az X-et?
Hol jelenjen meg a dátum?
Ahol X van, a dátum mindig az aktuális legyen, vagy az, amikor beírtad az X-et? -
#15246
Delila_1
veterán
medvezsolt
#15244
Delila_1
veterán
válasz
medvezsolt
#15244
üzenetére
Nem közölted, hova akarod írni az X-et, és hol legyen a dátum.
A makró akkor írja be a B oszlopba a dátumot, ha az A oszlopba írod be az X-et.
A laphoz rendelt a makrót.Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target = "X" Then _
Range("B" & Target.Row) = Date
End Sub -
Delila_1
veterán
Vigyél be A2-től feltételes formázást. A képlet:
=A2=A1
és adj fehér színt a karaktereknek. Ott maradnak az értékek, de nem látszanak.
Ha ez nem jó, írok rá egy makrót.Belefért az időbe, itt a makró:
Sub valami()
Dim sor As Integer
sor = 2
Do While Cells(sor, 1) > ""
If Cells(sor, 1) = Cells(sor - 1, 1) Then Cells(sor, 1) = ""
sor = sor + 1
Loop
End Sub -
Delila_1
veterán
válasz
w.miki
#15149
üzenetére
Beírod pl. az A1 cellába a "3halado_1/Halado03_mondatok_001"szöveget. Lemásolod, és örülsz, hogy szépen növeli a sorszámot.
B1 -> =A1&"_angol.mp3" , ezt is lemásolod.
Kijelölöd és másolod a B oszlopot, A1-re állsz, és irányítottan, értékként beilleszted. A B oszlop tartalmát törölheted.Ezt gyorsabban végrehajtod, mint ahogy én leírtam.
-
Delila_1
veterán
Mivel nem árultad el, hol lesznek az adatok, a D2:E8 tartományra írtam meg, majd átalakítod a makrókat.
Sub Start()
UserForm1.ListBox1.List = Sheets("Munka1").Range("E2:E8").Value
UserForm1.Show
End SubPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sor%, usor%, nev$
sor% = Me.ListBox1.ListIndex + 1
usor% = Cells(Rows.Count, "A").End(xlUp).Row + 1
nev$ = Me.ListBox1.List(Me.ListBox1.ListIndex)
Range("B" & usor%) = nev$
Range("A" & usor%) = Range("D" & Application.WorksheetFunction.Match(nev$, Columns(5), 0))
End Sub -
Delila_1
veterán
Például így oldhatod meg.
A listbox tartománya a Munka1 lap A1:A10.Ezzel indítod a userformot.
Sub start()
UserForm1.ListBox1.List = Sheets("Munka1").Range("A1:A10").Value
UserForm1.Show
End SubA listbox kiválasztott elemén duplaklikkre beírja az elemet a füzet aktuális cellájától egy cellával jobbra.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sor As Integer
sor = Me.ListBox1.ListIndex + 1
Selection.Offset(, 1) = Range("A" & sor)
End SubA +1 azért kell, mert az index nullával kezdődik.
-
Delila_1
veterán
válasz
zz76zz
#14942
üzenetére
Eléggé dodonai módon fogalmaztál. Van egy oszlop cikkszámokkal... Hol van az az oszlop?
Írtam egy makrót, ahol a Munka1 lap A oszlopában van a cikkszám, az első sorban a dátumok. A cikkszámok sorában, a fenti dátumok oszlopában az aznap rendelt mennyiségek.
Ezekből az adatokból készít a makró egy új táblázatot a Munka2 lapon, ahol az A oszlop a cikkszámot tartalmazza, a B a dátumot, a C pedig a rendelt mennyiséget. Azokat a napokat, mikor nem volt a cikkszámhoz tartozó rendelés, kihagyja.
Ha nem ilyent szerettél volna, magadra vess a homályos fogalmazás miatt.
Sub valami()
Dim sor%, usor%, oszlop%, uoszlop%, WS As Worksheet
Dim sorW%, cikksz, f As Boolean
usor% = ActiveSheet.UsedRange.Rows.Count
uoszlop% = ActiveSheet.UsedRange.Columns.Count
Set WS = Sheets("Munka2")
sorW% = 2
Sheets("Munka1").Select
Application.ScreenUpdating = False
For sor% = 2 To usor%
cikksz = Cells(sor%, 1)
For oszlop% = 2 To uoszlop%
If Application.WorksheetFunction.CountA(Rows(sor%)) > 1 Then
f = False
If Cells(sor%, oszlop%) > 0 Then
WS.Cells(sorW%, 1) = cikksz
WS.Cells(sorW%, 2) = Cells(1, oszlop%)
WS.Cells(sorW%, 3) = Cells(sor%, oszlop%)
f = True
End If
End If
If f Then sorW% = sorW% + 1
Next
Next
Sheets("Munka2").Select
Application.ScreenUpdating = False
End SubSzerk.: a sorok és oszlopok számától függően elmókuskálhat a makró egy darabig.
-
Delila_1
veterán
válasz
#05304832
#14963
üzenetére
Az összefűzésből kihagyom az F oszlopot, az M oszlopba beíratom a SZUMHA függvényt, ennek az értékét másoltatom az F oszlopba.
Sub Gyomlal_1()
Dim sor%, usor%
usor% = Range("A1").End(xlDown).Row
'Adatok összefűzése az N oszlopba
Range("N1") = "Összefűzve"
Range("N2:N" & usor%) = "=A2&B2&C2&D2&E2&G2&H2&I2&J2&K2&L2"
'Irányított szűrés az U oszlopba
Range("N1:N" & usor%).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"U1"), Unique:=True
'M oszlopba FKERES-sel darabszám, AE-be SZUMHA függvény
Range("M1") = "Egyedi tétel"
For sor% = 2 To usor%
Range("M" & sor%) = Application.WorksheetFunction.VLookup(Range("N" & sor%), Range("U:AD"), 10, 0)
Cells(sor%, "AE").FormulaR1C1 = "=SUMIF(C[-17],RC[-17],C[-25])"
Next
Range("AE2:AE" & usor%).Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues
'Azonos sorok törlése
For sor% = usor% To 2 Step -1
If Application.CountIf(Range("N:N"), Range("N" & sor%)) > 1 Then _
Range("A" & sor% & ":M" & sor%).Delete shift:=xlUp
Next
'Segédoszlopok adatainak törlése
Columns("M:AE").ClearContents
End Sub -
-
Delila_1
veterán
-
Delila_1
veterán
válasz
#05304832
#14943
üzenetére
Ha jól értem, egy lapon van sok, változó számú sorod.
Az adatok az A:L tartományban vannak.
Előfordulnak teljesen megegyező sorok.
Ezeket kell kigyomlálni, hogy az azonosakból csak 1 maradjon, és a sorban feltüntetni, hogy a törlés előtt hány volt az egyes duplikált sorból.Sub Gyomlal()
Dim sor%, usor%, usor1%
usor% = Range("A1").End(xlDown).Row
'Adatok összefűzése az N oszlopba
Range("N1") = "Összefűzve"
Range("N2:N" & usor%) = "=A2&B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&L2"
'Irányított szűrés az U oszlopba
Range("N1:N" & usor%).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"U1"), Unique:=True
usor1% = Range("U1").End(xlDown).Row 'U oszlop alsó sora
'AD oszlopba darabszám
Range("AD1") = "Db"
Range("AD2:AD" & usor1%).FormulaR1C1 = "=COUNTIF(R2C14:R" & usor% & "C14,RC[-9])"
'M oszlopba FKERES-sel darabszám
Range("M1") = "Egyedi tétel"
For sor% = 2 To usor%
Range("M" & sor%) = Application.WorksheetFunction.VLookup(Range("N" & sor%), Range("U:AD"), 10, 0)
Next
'Azonos sorok törlése
For sor% = usor% To 2 Step -1
If Application.CountIf(Range("N:N"), Range("N" & sor%)) > 1 Then _
Range("A" & sor% & ":M" & sor%) = ""
Next
'Segédoszlopok adatainak törlése
Columns("N:AE").ClearContents
End Sub -
Delila_1
veterán
válasz
CHANNIS
#14930
üzenetére
Átalakítottam.
Sub alma()
Dim sor%, tol%, ig%, usor%, nev$
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Worksheets("Munka1")
Set WS2 = Worksheets("Munka2")
usor% = WS2.Range("I" & Rows.Count).End(xlUp).Row
For sor% = 3 To usor%
nev$ = WS2.Range("I" & sor%)
ig% = Application.WorksheetFunction.Match(nev$, WS1.Columns(2), 0)
tol% = ig%
Do While WS1.Cells(ig%, 2) = nev$
ig% = ig% + 1
Loop
WS1.Rows(ig%).EntireRow.Insert
WS1.Cells(ig%, "B") = WS2.Cells(sor%, "I")
WS1.Cells(ig%, "C") = WS2.Cells(sor%, "G")
WS1.Cells(ig%, "E") = WS2.Cells(sor%, "J")
WS1.Cells(ig%, "G") = WS2.Cells(sor%, "K")
WS1.Rows(ig% + 1).EntireRow.Insert
WS1.Rows(ig% + 2).EntireRow.Insert
Next
End Sub -
Delila_1
veterán
válasz
#05304832
#14914
üzenetére
Azt kérted, hogy ha a MÁSODIK sor valamelyik cellája egyezik a felsoroltakkal, akkor ne törölje az oszlopot. Te most az ELSŐ sorba írtad a címeket, a másodikban nem találhatóak ezek a nevek.
Vagy szúrj be 1 sort az első fölé, hogy a másodikba kerüljenek a nevek, vagy a makróban azIf Sheets("Sheet 1").Cells(2, oszlop%) = T(Tag%) Then sort írd át
If Sheets("Sheet 1").Cells(1, oszlop%) = T(Tag%) Then-re.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
#05304832
#14907
üzenetére
Szia!
Sub Oszlopok()
Dim T, Tag%, f As Boolean
Dim oszlop%, uoszlop%
T = Array("LENX", "LENY", "LENZ", "MATERIAL", "NAME", "SUMMARY", "TIP", "A1", "A2", "B1", "B2", "HIV")
uoszlop% = Sheets("Sheet1").UsedRange.Columns.Count
For oszlop% = uoszlop% To 1 Step -1
f = False
For Tag% = 0 To 11
If Sheets("Sheet1").Cells(2, oszlop%) = T(Tag%) Then
f = True
Exit For
End If
Next
If f = False Then Columns(oszlop%).Delete shift:=xlToLeft
Next
End Sub -
Delila_1
veterán
válasz
CHANNIS
#14900
üzenetére
Tedd ki a füzetet egy elérhető helyre. Nincs időm újra beirkálni az adataidat egy másik helyre. Ha azonnal az igazi helyükkel teszed fel a kérdést, már kész lenne. A makrót az előzően betett képeken szereplő oszlopokhoz írtam meg. Nem értem, miért más helyekre kérdeztél rá, nem a valósra.
-
Delila_1
veterán
válasz
#05304832
#14894
üzenetére
A 14811-es kérdésed szerint több adatod van, amiknek megfelelően több oszlopot kell meghagyni. Erre a 14863-as választ kaptad. A válasz szerint a keresendő értékek az egyik-, a törlendő oszlopok a másik lapon helyezkednek el.
A 14888-ban egyetlen értéket (LEVEL) kerestetsz, erre a 14891-ben kaptál választ.
A 14892-ben azt írod, 1 lapod és több nem törlendő oszlopod van. Hol van a lapon a nem törlendők megnevezése? Pontatlan kérdésre nem lehet jó választ adni.
-
Delila_1
veterán
válasz
#05304832
#14892
üzenetére
Sub oszlop_torles()
Dim oszlop%, nev$
nev$ = "LEVEL"
For oszlop% = 36 To 1 Step -1
If Cells(2, oszlop%) <> nev$ Then Columns(oszlop%).Delete Shift:=xlToLeft
Next
End SubEzzel már nagyon gyorsan lefut majd. Benne felejtettem egy nem oda való ciklust az előzőből, mikor több címszóra kellett rákeresni, bocsi. Mentségemre, hogy el kell mennem, ezért kapkodok.
-
Delila_1
veterán
válasz
#05304832
#14888
üzenetére
Ha csak 1 lapról és 1 adatról van szó, elég ez:
Sub oszlop_torles()
Dim sor%, usor%, oszlop%, nev$
usor% = Application.WorksheetFunction.CountA(Columns(1))
For sor% = 1 To usor%
nev$ = "LEVEL"
For oszlop% = 36 To 1 Step -1
If Cells(2, oszlop%) <> nev$ Then Columns(oszlop%).Delete Shift:=xlToLeft
Next
Next
End Sub -
Delila_1
veterán
válasz
CHANNIS
#14882
üzenetére
Küldöm az ígért makrót. A lista1 nálam az első lapon van, a lista2 pedig a másodikon.
Ezt adom meg a két 'Set =' kezdetű sorban.Sub alma()
Dim sor%, tol%, ig%, usor%, nev$, aktual%
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
usor% = WS2.Range("J" & Rows.Count).End(xlUp).Row
For sor% = 3 To usor%
nev$ = WS2.Range("J" & sor%)
aktual% = Application.WorksheetFunction.Match(nev$, WS1.Columns(2), 0)
tol% = aktual%
Do While WS1.Cells(aktual%, 2) = nev$
aktual% = aktual% + 1
Loop
ig% = aktual% - 1
WS1.Rows(ig% + 1).EntireRow.Insert
WS1.Cells(ig% + 1, 1) = WS1.Cells(ig%, 1)
WS1.Cells(ig% + 1, 2) = WS1.Cells(ig%, 2)
WS1.Cells(ig% + 1, 4) = WS2.Cells(sor%, "K")
WS1.Rows(ig% + 2).EntireRow.Insert
WS1.Rows(ig% + 3).EntireRow.Insert
WS1.Cells(tol%, 4) = "=SUM(D" & tol% + 1 & ":D" & ig% + 3 & ")"
Next
End Sub -
Delila_1
veterán
válasz
#05304832
#14875
üzenetére
Próba nélkül! átalakítottam az előbb küldött makrót.
Sub oszlop_torles()
Dim sor%, usor%, oszlop%, nev$
Dim WS1 As Worksheet, WS2 As WorksheetSet WS1 = Sheets("Keresendő")
Set WS2 = Sheets("Adatok")
usor% = Application.WorksheetFunction.CountA(WS1.Columns(1))For sor% = 1 To usor%
nev$ = WS1.Cells(sor%, "A")
For oszlop% = 36 To 1 Step -1
If WS2.Cells(2, oszlop%) <> nev$ Then Columns(oszlop%).Delete Shift:=xlToLeft
Next
Next
End SubSzerk.: Nem jelöltem programkódnak, utólag nem lehet javítani, de biztosan meg tudod csinálni. Ilyen pocsék formában is működnie kell.
-
Delila_1
veterán
válasz
#05304832
#14811
üzenetére
Nem pontos a kérdés felvetése, azért nem válaszoltam eddig rá.
Azt írod, az "A2 sorban keressen neveket ". Az A2 egy cella, nem egy sor.Írtam egy makrót. A füzetben a Keresendő lap A oszlopában vannak a nevek (NAME, SUMMARY, stb.), az Adatok lapon pedig az oszlopok. A makró kitörli azokat az oszlopokat, amiknek a 2. sorában szerepel valamelyik a felsorolt nevek közül. Ha ez jó, akkor megírom a másikat is. Ugyanazt a táblázatot kell így is, úgy is kigyomlálni? Az a cél, hogy az Adatok lapon minden sor és oszlop eltűnjön, amelyikben valamelyik szó szerepel a felsoroltak között?
Sub oszlop_torles()
Dim sor%, usor%, oszlop%, uoszlop%, nev$
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Sheets("Keresendő")
Set WS2 = Sheets("Adatok")
usor% = Application.WorksheetFunction.CountA(WS1.Columns(1))
For sor% = 1 To usor%
nev$ = WS1.Cells(sor%, "A")
uoszlop% = WS2.Cells(2, 256).End(xlToLeft).Column
For oszlop% = uoszlop% To 1 Step -1
If WS2.Cells(2, oszlop%) = nev$ Then Columns(oszlop%).Delete Shift:=xlToLeft
Next
Next
End Sub -
Delila_1
veterán
Makróval megoldható.
Sub Nyomtat()
Dim lap%
For lap% = 1 To Worksheets.Count
Sheets(lap%).Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$35"
ActiveSheet.PageSetup.Orientation = xlPortrait
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.PageSetup.PrintArea = "$A$36:$M$62"
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next
End SubA két helyen az ActiveSheet.PageSetup.PrintArea = kezdetű sorokban a saját nyomtatandó területeidet add meg.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
#05304832
#14839
üzenetére
Megoldható, csak egy kicsit macerás. Egy üres oszlopban össze kell fűznöd az A2:K2 tartomány adatait, célszerűen 1-1 szóközzel közöttük. Legyen ez az L oszlop. Ezt lemásolod a 226. sorig. Eszerint rendezed a teljes tartományt, utána a DARABTELI függvény megadja a darabszámot az M oszlopban.
Az egyszeri összefűzés kicsit türelemjáték.
-
Delila_1
veterán
válasz
Gandalf80
#14837
üzenetére
Egy lap első sorába felviszed a kerületeket. Mindegyik alá az ott található utcákat beírod.
Kijelölöd a tartományt az utolsó sorig. Képletek | Definiált nevek | Kijelölésből új. A párbeszéd ablakban a 'Felső sorból' mellett maradjon pipa, OK. Kaptál 23 névvel ellátott tartományt.Az első érvényesítés lista forrása A1:W1. Legyen pl. ez a másik lap A1 cellájában. A B1 is érvényesítés lesz, szintén lista. Ennél a forrás: =INDIREKT(A1)
Szerk.: figyelmesebben olvasva a kérdésedet nem az egyes kerületek, hanem az irányítószámok szerinti utcákat akarod listázni. A felső sorba az irányítószámokat írd, de itt cselezni kell, mert nem szereti névadásnál a számokat. Mindegyik elé tegyél egy alsó kötjelet, pl. _1027.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Steam, GOG, Epic Store, Humble Store, Xbox PC Game Pass, Origin Access, uPlay+, Apple Arcade felhasználók barátságos izgulós topikja
- Hálózati / IP kamera
- Vezetékes FEJhallgatók
- A Micron újszerű módszerrel javítja QLC-s SSD-jének sebességét
- Otthoni időjárás-állomás
- Dune Awakening - Máris túl az 1 millión
- Konzol Screenshot
- Mesterséges intelligencia topik
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- További aktív témák...
- Gyermek PC játékok
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Sea of Thieves Premium Edition és Egyéb Játékkulcsok.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Lenovo Legion 5 Gaming. Az ár irányár, komoly érdeklődés esetén van lehetőség egyeztetésre
- Telefon felváráslás!! Samsung Galaxy S22/Samsung Galaxy S22+/Samsung Galaxy S22 Ultra
- AKCIÓ! Gigabyte H610M i5 12400F 16GB DDR4 512GB SSD RX 6700XT 12GB Zalman S2 TG Seasonic 650W
- BESZÁMÍTÁS! MSI SUPRIM X RTX 4080 16GB videokártya garanciával hibátlan működéssel
- ÁRGARANCIA!Épített KomPhone i5 13400F 16/32/64GB RAM RTX 4060 Ti 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest