- 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
pigster
#21841
üzenetére
Formátum a vonal eltüntetéséhez: # ###_,_— (alsó kötjel, vessző, alsó kötjel, 0151)
A képlet marad az előbbi.A formátumnál az alsó kötjel után megadott karakter szélességének megfelelően ad egy jobb oldali behúzást.
Például a 0,0_W a bevitt szám mögött egy W-nek megfelelő szélességű üres helyet hagy.Itt két karakterrel, a vesszővel, és a hosszú kötjellel kell behúzni, mindegyikhez külön be kell írni az alsó kötjelet.
-
-
Delila_1
veterán
válasz
toth60
#21831
üzenetére
A lapvédelem előtt add meg a háttérszínt az összes cellának. A makró a védett tartomány hátterét fehérre állítja a védelemmel azonos időben.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
Rows(Target.Row).Locked = True
Range("A" & (Target.Row) & ":E" & Target.Row).Interior.Color = vbWhite
End If
End Sub -
Delila_1
veterán
válasz
toth60
#21828
üzenetére
Én vagyok a hibás. Az 1. pontban nem írtam meg, hogy az írható cellák zárolását vedd le, akkor már nem lesz hiba.
Ha azt akarod, hogy az 5. (E) oszlopba írás után legyen a teljes sor zárolt, akkor az A:E oszlopok celláinak a zárolása elől vedd ki a pipát a cellaformázásnál, a makró pedig a laphoz rendelve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
Rows(Target.Row).Locked = True
End If
End SubA makró bemásolásakor írd át az aaa jelszót a saját jelszavadra.
-
Delila_1
veterán
válasz
toth60
#21826
üzenetére
1. Jelöld ki együttesen a cellákat, amikbe engeded a beírást. Ezt például a Ctrl billentyű nyomva tartása mellett a cellákra kattintással teheted meg.
2. Adj nevet a kijelölt területnek, legyen a név zárolni.
3. Védd le a lapot. A védelemnél a Zárolt cellák kijelölése elől vedd ki a pipát, a Nem zárolt cellák kijelölése legyen kijelölve. Nálam a jelszó aaa, ehelyett vigyél be valami mást.
4. Lapfülön jobb klikk, Kód megjelenítése. Bejutottál a VB szerkesztőbe, ahol a jobb oldali üres felületre másold be a lenti makrót.
5. Írd át az
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
sorban az aaa-t a saját jelszavadra, indulhat a munka.Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
If Not Intersect(Target, Range("zárolni")) Is Nothing Then Range(Target.Address).Locked = True
End Sub -
Delila_1
veterán
válasz
David888
#21812
üzenetére
Szia!
A verseny lap D4-es cellájában a képlet
=INDEX(iskola!A:D;HOL.VAN(D4;iskola!D:D;0);1)A súgóból:
Szintaktika: INDEX(tömb;sor_szám;oszlop_szám)
Táblázat vagy tömb azon elemének értékét adja vissza, amelyet a sorszám és oszlopszám mint index meghatároz.A képletben a sor_számot a HOL.VAN függvénnyel határoztam meg, ahol pontos értéket kerestem (az utolsó paraméter 0). Az oszlop_szám értéke 1, mert az iskolák nevét az első oszlop tartalmazza.
Így is lehetett volna:
=INDEX(iskola!$A$1:$D$5;HOL.VAN(D4;iskola!D:D;0);1)
Ha az iskola lapon nem a teljes A
oszlopot adom meg, akkor a tartományt fixen kell megadni, erre szolgálnak a $ jelek. -
Delila_1
veterán
Kevés változtatással:
Sub Laptorles()
Dim lap As Integer
Application.DisplayAlerts = False
For lap = Sheets.Count To 1 Step -1
If Sheets(lap).Name <> "sorsolás" And Sheets(lap).Name <> "összesítő" Then
Sheets(lap).Delete
End If
Next
Application.DisplayAlerts = True
End SubFor-Next ciklusban a törléseket célszerű a tartomány végétől az elejéig végrehajtani. Ez főként sorok, oszlopok törlésére vonatkozik.
-
Delila_1
veterán
Sub Valami()
Dim sor As Integer, sor1, WS2 As Worksheet, WF As WorksheetFunction
Set WS2 = Worksheets("Munka2")
Set WF = Application.WorksheetFunction
Sheets("Munka1").Select
For sor = 10 To 13
sor1 = 0
On Error Resume Next
sor1 = WF.Match(Cells(sor, "N"), WS2.Columns("N"), 0)
WS2.Cells(sor1, "O") = WS2.Cells(sor1, "O") + Cells(sor, "O")
Next
End Sub -
Delila_1
veterán
válasz
bagira82
#21788
üzenetére
Sub diagram()
a = "Anna": b = "Józsi": c = "Emil": d = "Tamás"
aa = 100: bb = 120: cc = 140: dd = 200
tengely = Array(a, b, c, d)
ertekek = Array(aa, bb, cc, dd)
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = xl3DPieExploded
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.Name = "='Munka5'!$B$1"
.Values = ertekek
.XValues = tengely
.ApplyDataLabels
End With
End With
End Sub -
Delila_1
veterán
válasz
bagira82
#21784
üzenetére
Sub diagram()
ertekek = Array(103, 405, 349, 532)
tengely = Array("Anna", "Teri", "Emil", "Ida")
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = xl3DPieExploded
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.Name = "='Munka5'!$B$1"
.Values = ertekek
.XValues = tengely
.ApplyDataLabels
End With
End With
End Sub -
#21772
Delila_1
veterán
marchello1
#21770
Delila_1
veterán
válasz
marchello1
#21770
üzenetére
Szívesen.
-
#21767
Delila_1
veterán
marchello1
#21765
Delila_1
veterán
válasz
marchello1
#21765
üzenetére
Az A4:A33 tartomány feltételes formázásának a képlete
=HÓNAP(A4)>HÓNAP(A$3), ehhez fehér karakterszínt rendelj, és add meg a többi oszlopra is. Fontos a $ jel a hármas előtt!
-
Delila_1
veterán
válasz
Zola007
#21755
üzenetére
Írtam hozzá egy felhasználói függvényt.
Function Osszegszer(osszeg As String, szorzo)
kk = Split(osszeg, ", ")
For i = 0 To UBound(kk)
osszeadando = osszeadando + kk(i) * 1
Next
szorzat = osszeadando * szorzo
Osszegszer = szorzat
End FunctionA makrót bemásolod a füzetedbe egy új modulba (a VB szerkesztőben).
A példád szerint a füzetben így adod meg: =Osszegszer(A10;B10)A zárójelben az első paraméter annak a cellának a címe, amiben a számok vannak vesszővel és szóközzel elválasztva, a második a szorzót tartalmazó cella címe.
-
Delila_1
veterán
válasz
slashing
#21752
üzenetére
Nem értettelek félre, csak javasoltam egy egyszerű megoldást, amit autoszűrővel hajthatsz végre.
Irányított szűrővel is megkaphatnád az eredményt, de ahhoz is minden sorban kellene szerepelnie a sorszámnak. Az Excel módot ad a cellák összevonására, de sok esetben – mint a példádban is – nem tudja helyesen kezelni.Átlátható marad a táblázatod, ha ügyesen adsz feltételes formázást. Az A3 cellától lefelé kell kijelölnöd az A oszlopban kitöltött tartományt, miután megszüntetted a cellák összevonását.
Az egyik képlet a formátumban =A3=A2, itt a karakter színét kell beállítanod a háttér színére, a feltett kép szerint fehérre.
A másik képlet =A3<>A2, ennél egy felső szegélyt kell beállítanod..
A B:C tartomány legyen kívül-belül szegélyezve. Az A oszlop hátterét fehérre állítva a cellarácsok sem zavarják a képet, de a beállításoknál is megszüntetheted a cellarácsok megjelenítését.
Ilyen lesz:
-
Delila_1
veterán
Egy halom idézőjelet tettél bele feleslegesen, és a $-t kihagytad.
Jelöld ki az A2:F4 területet. A formázás képlete: =$E2="nem"
Add meg a formátumot, és kész. Új szabály, ugyanez a képlet, csak a "nem" helyére "igen" jön, és a háttér zöld.A további sorokra a formátumfestő ecsettel másolhatod a formátumot, vagy a feltételes formázás | Szabályok kezelése ablakában egyszerűen átírod az érvényességet a teljes területedre.
-
Delila_1
veterán
válasz
Gabcsika
#21735
üzenetére
Feltöltöttem az átírt makróval a füzetedet ide.
Igaz, ahogy itt írtam, a lapnevek kijavításával helyre rázódott volna a lelke, de most egy-egy oldalnyi adat átmásolása után üzenetet kapsz a nyomtatásra.
Az F1 cella tartja számon a Munka1 lapon, hogy hol tartasz a másolással és nyomtatással, azt ne töröld ki. Mikor mindent kinyomtattál, akkor vált át üres stringre.
-
Delila_1
veterán
Érvényesítésben add meg a két választható elemet.
A feltételes formázásnál erre a cellára kell hivatkoznod. Ha pl. a B oszlopban van az érvényesítés, az adatok meg A2-től Q1000-ig, akkor kijelölöd a teljes területet. A feltételes formázáshoz 2 képletet vigyél be.
=$B2="igen" és =$B2="nem". A két képlethez külön add meg a két háttérszínt. Fontos a $ jel az érvényesítést tartalmazó oszlop betűjele előtt. -
-
#21733
Delila_1
veterán
ritterkrisz
#21729
Delila_1
veterán
válasz
ritterkrisz
#21729
üzenetére
Másik megoldás, hogy felveszel ideiglenes egy segédoszlopot, ahol a képlet
="product/" & D2
Ezt végig másolod. Kijelölöd a képletet tartalmazó cellákat, Ctrl+c-vel másolod, beállsz a D2 cellába, jobb klikk, Irányított beillesztés, Értéket. A segédoszlopot törölheted.
-
Delila_1
veterán
válasz
slashing
#21728
üzenetére
Meg kell szüntetned az összevonásokat az A oszlopban, mert emiatt nem tudsz autoszűrővel szűrni. Nézz el ide. Ezután már nincs szükség az I:K celláira, helyben tudsz szűrni.
Hogy ne legyenek zavaróak az A oszlop ismétlődő adatai, az A3 cellától lefelé vigyél be feltételes formázást. A képlete =A3=A2, és a karakter színének add meg a cellák háttérszínét.
A feltételes formázás első egyenlőségjelét HA szóként kell értelmezni. Itt: ha az aktuális cella tartalma megegyezik a fölötte lévővel, akkor jöhet a formázás.
-
-
Delila_1
veterán
válasz
KERO_SAN
#21719
üzenetére
Tényleg nem egészen világos, mit szeretnél. Nem tudom, mitől függ, hogy a 2. táblázatban melyik az a bizonyos n-edik sor.
Szerintem az 1. táblázathoz vegyél fel egy új oszlopot, ami a dátumok hónapját adja a
=HÓNAP(A2) függvénnyel. Akkor egyszerű a szűrés ebben az új oszlopban. -
Delila_1
veterán
válasz
KERO_SAN
#21716
üzenetére
Szűröd az A oszlopot. A táblázaton kívül egy üres cellába, pl. a Z1-be (ha az üres), beírod a függvényt.
=RÉSZÖSSZEG(9;B:B)
A másik lapra, ahol a mindenkori részösszeget akarod megjeleníteni, ennyit írsz: =Munka1!Z1
Természetesen a Munka1 helyett a saját lapod nevét írd be. -
Delila_1
veterán
válasz
Gabcsika
#21708
üzenetére
Itt a manuális nyomtatáshoz a makró, bár nálam hiba nélkül végrehajt mindent.
Sub Nyomtat()
Dim sor1 As Long, sor2 As Long
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet1").Select
If Range("V1") = "" Then Range("V1") = 2
sor1 = Range("V1"): sor2 = 1
Do While sor2 <= 66
Range("A" & sor1 & ":C" & sor1 + 4).Copy
Sheets("Sheet2").Range("A" & sor2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
sor1 = sor1 + 5
sor2 = sor2 + 3
Loop
Range("V1") = sor1
Sheets("Sheet2").Select
MsgBox "Nyomtass"
If Application.CountA(Sheets("Sheet1").Columns(1)) < sor1 Then _
Sheets("Sheet1").Range("V1") = ""
End Sub -
#21707
Delila_1
veterán
atillaahun
#21703
Delila_1
veterán
válasz
atillaahun
#21703
üzenetére
Igen, a csere funkcióval, minden ékezetesre külön.
-
-
Delila_1
veterán
válasz
Gabcsika
#21699
üzenetére
Másol, kinyomtatja az első átmásolt mennyiséget, törli a Sheet2 lap tartalmát, másolja és nyomtatja a következőt. Ezt addig folytatja, míg a Sheet1 lapon talál adatot
Az utolsó adagot az én hibám miatt nem nyomtatja. Az eredeti makró Loop sora alá másold be:
If Sheets("Sheet2").Range("A1") > "" Then
Sheets("Sheet2").Select
ActiveWindow.ActiveSheet.PrintOut Copies:=1, Collate:=True
Cells.ClearContents
Sheets("Sheet1").Select
End If -
Delila_1
veterán
válasz
Gabcsika
#21692
üzenetére
Próbáld meg ezzel a makróval.
Sub Nyomtat()
Dim sor1 As Long, sor2 As Long
Sheets("Sheet1").Select
sor1 = 2: sor2 = 1
Do While Cells(sor1, "A") <> ""
Range("A" & sor1 & ":C" & sor1 + 4).Copy
Sheets("Sheet2").Range("A" & sor2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
sor1 = sor1 + 5
If sor2 >= 63 Then
Sheets("Sheet2").Select
ActiveWindow.ActiveSheet.PrintOut Copies:=1, Collate:=True
Cells.ClearContents
Sheets("Sheet1").Select
sor2 = 1
Else: sor2 = sor2 + 3
End If
Loop
End Sub -
Delila_1
veterán
válasz
alfa20
#21675
üzenetére
A Page2 azonos a beillesztett képpel, csak az objektumok neve más.
Private Sub CommandButton1_Click()
If OptionButton1_1 Then
OB1_1
ElseIf OptionButton1_2 Then OB1_2
Else: MsgBox "Mi lesz?"
End If
End Sub
Private Sub CommandButton2_Click()
If OptionButton2_1 Then
OB2_1
ElseIf OptionButton2_2 Then OB2_2
Else: MsgBox "Mi lesz?"
End If
End Sub
Sub OB1_1()
MsgBox "OB1_1"
End Sub
Sub OB1_2()
MsgBox "OB1_2"
End Sub
Sub OB2_1()
MsgBox "OB2_1"
End Sub
Sub OB2_2()
MsgBox "OB2_2"
End Sub -
#21656
Delila_1
veterán
atillaahun
#21655
Delila_1
veterán
válasz
atillaahun
#21655
üzenetére
Szívesen.
-
#21654
Delila_1
veterán
atillaahun
#21652
Delila_1
veterán
válasz
atillaahun
#21652
üzenetére
C1-be
=HA(DARABTELI(B:B;B1)>1;SZUMHA(B:B;B1;A:A);"") -
#21644
Delila_1
veterán
anonymus89
#21643
Delila_1
veterán
válasz
anonymus89
#21643
üzenetére
Na és mi ezzel a baj?
-
#21642
Delila_1
veterán
anonymus89
#21641
Delila_1
veterán
válasz
anonymus89
#21641
üzenetére
-
#21640
Delila_1
veterán
anonymus89
#21639
Delila_1
veterán
válasz
anonymus89
#21639
üzenetére
Ha valamelyik adatsort a második Y tengelyhez rendeled, a két oszlop egymást fedi. Kijelölöd az egyik oszlop tartományt, és szélesebbre veszed (a közt kisebbre állítod), és már látszik is minden adatod.
-
#21593
Delila_1
veterán
PindurAnna
#21592
Delila_1
veterán
válasz
PindurAnna
#21592
üzenetére
Kijelölöd a formázandó területet. A formázás képlete
=JOBB($A1;2)<>BAL($B1;2)
-
Delila_1
veterán
válasz
bandus
#21587
üzenetére
mit = Range("a5")
Columns("A:A").Find(What:=mit, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
MsgBox Selection.RowSzerk.: itt a keresés végén a Select utasítást látod. Erre azért van szükség, hogy utána le tudd kérdezni a pozícióját. Előtte az A oszlopot jelölted ki, Activate utasítással 1-et írna a találat sorának.
-
-
Delila_1
veterán
válasz
bandus
#21584
üzenetére
Az egyszerűség kedvéért a keresést rögzítéssel vettem fel. utólag vettem észre, hogy nem állítottam le a rögzítést. A makró csak ennyi:
Sub Keres()
Dim tofind As Date, sor As Long, oszlop As Long
tofind = Range("A3")
Sheets("FEL").Select
Cells.Find(What:=tofind, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
sor = Selection.Row
oszlop = Selection.Column
MsgBox "Sor: " & sor & vbLf & "Oszlop: " & oszlop
End Sub -
Delila_1
veterán
válasz
ildikol
#21577
üzenetére
Az a gyanúm, hogy nem pontosan másoltad a makrót. A
Cells(Target.Row, "Q") = Time sor határozza meg a beírandó MOST() függvény helyét.Képet akarsz betenni? Annak nincs sok értelme. Tedd ki a fájlt egy elérhető helyre, de előbb a nem publikus adatok helyett írj bele kamu értékeket.
-
Delila_1
veterán
válasz
ildikol
#21575
üzenetére
Töröld ki az If Target.Column = 16 Then sort, és a hozzá tartozó utolsót, az End If-et.
Lesz egy káros hatása. Ahányszor beírsz valamit az első lapra, annak a sorát átmásolja egy új sorba a másik lapra. Mire kitöltöd a teljes sort (A-tól P-ig), 16 új sorod lesz a másoltakat tartalmazó lapon.
-
#21570
Delila_1
veterán
littleNorbi
#21569
Delila_1
veterán
válasz
littleNorbi
#21569
üzenetére
Nincs mit.
-
#21568
Delila_1
veterán
kerteszke3
#21567
Delila_1
veterán
válasz
kerteszke3
#21567
üzenetére
Örülök neki, szívesen.
-
#21566
Delila_1
veterán
kerteszke3
#21565
Delila_1
veterán
válasz
kerteszke3
#21565
üzenetére
Tömbképlet! beírod a képletet a kapcsos zárójelek nélkül, majd a szerkesztőlécen állva Shift+Ctrl+Enterrel viszed be.
{=DARAB(HA((A1:A5)=(B1:B5);B1:B5))}
-
#21561
Delila_1
veterán
lazlogogola
#21558
Delila_1
veterán
válasz
lazlogogola
#21558
üzenetére
Küldd el a két fájlt, privátban megadom a címet.
-
#21556
Delila_1
veterán
sutyimatyi
#21554
Delila_1
veterán
válasz
sutyimatyi
#21554
üzenetére
Nem látom át, miket számolsz. Van kezdési idő, de nincs végzés.
Mondd meg a főnöknek, hogy neki is könnyebb lefelé görgetni, mint oldalra. Mindig azt tesszük a sorokba, amiből több van. Itt a napokból max. 31 van, ráadásul naponként 3 adatot kell látni. Fordított elrendezésnél minden adat látszik az oszlopokban.
-
#21553
Delila_1
veterán
lazlogogola
#21544
Delila_1
veterán
válasz
lazlogogola
#21544
üzenetére
Látatlanban arra gondolok, hogy a forrásban nem az A1-ben kezdődnek az adataid.
-
#21551
Delila_1
veterán
sutyimatyi
#21545
Delila_1
veterán
válasz
sutyimatyi
#21545
üzenetére
A helyedben elfordítanám 90°-kal a táblázatot.
-
Delila_1
veterán
válasz
gobe22
#21548
üzenetére
Az üres sorok törlésével kezd, nem szükséges a kijelölés, azonnal futtatható. Feltételezem, hogy a txt fájlból az adatokat az A1-től kezdve másolod be.
Sub VizszRend()
Dim usor As Long, sor As Long
Application.DisplayAlerts = False
'Üres sorok törlése
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Szövegből oszlopok
usor = Application.CountA(Columns(1))
Range("A1:A" & usor).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
'Rendezés soronként
For sor = 1 To usor
Rows(sor).Select
Selection.Sort Key1:=Range("A" & sor), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next
'Összefűzés az N oszlopban
Range("N1:N" & usor).FormulaR1C1 = _
"=RC[-13]&"",""&RC[-12]&"",""&RC[-11]&"",""&RC[-10]&"",""&RC[-9]&"",""&RC[-8]&"",""&RC[-7]&"",""&RC[-6]&"",""&RC[-5]&"",""&RC[-4]&"",""&RC[-3]&"",""&RC[-2]"
'N oszlop irányított beillesztése az A-ba
Range("N:N").Copy
Range("A1").PasteSpecial xlPasteValues
'Segédoszlopok törlése
Range("B:N").ClearContents
'Többszörös vesszők törlése
sor = 0
Do While sor < 3
Cells.Replace What:=",,", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
sor = sor + 1
Loop
'Utolsó vessző törlése képlettel a H oszlopba
Range("H1:H" & usor).FormulaR1C1 = _
"=IF(RIGHT(RC[-7],1)="","",LEFT(RC[-7],LEN(RC[-7])-1),RC[-7])"
'H oszlop másolása az A-ba
Range("H:H").Copy
Range("A1").PasteSpecial xlPasteValues
Range("H:H").ClearContents 'H oszlop törlése
Application.DisplayAlerts = False
End Sub -
Delila_1
veterán
válasz
gobe22
#21543
üzenetére
Kicsit sok volt a buktató.
Kijelölöd a tartományt az A oszlopban, és indítod a makrót.Sub VizszRend()
Dim usor As Long, sor As Long
Application.DisplayAlerts = False
'Szövegből oszlopok
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
'Rendezés soronként
usor = Application.CountA(Columns(1))
For sor = 1 To usor
Rows(sor).Select
Selection.Sort Key1:=Range("A" & sor), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next
'Összefűzés az N oszlopban
Range("N1:N" & usor).FormulaR1C1 = _
"=RC[-13]&"",""&RC[-12]&"",""&RC[-11]&"",""&RC[-10]&"",""&RC[-9]&"",""&RC[-8]&"",""&RC[-7]&"",""&RC[-6]&"",""&RC[-5]&"",""&RC[-4]&"",""&RC[-3]&"",""&RC[-2]"
'N oszlop irányított beillesztése az A-ba
Range("N:N").Copy
Range("A1").PasteSpecial xlPasteValues
'Segédoszlopok törlése
Range("B:N").ClearContents
'Többszörös vesszők törlése
sor = 0
Do While sor < 3
Cells.Replace What:=",,", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
sor = sor + 1
Loop
'Utolsó vessző törlése képlettel a H oszlopba
Range("H1:H" & usor).FormulaR1C1 = _
"=IF(RIGHT(RC[-7],1)="","",LEFT(RC[-7],LEN(RC[-7])-1),RC[-7])"
'H oszlop másolása az A-ba
Range("H:H").Copy
Range("A1").PasteSpecial xlPasteValues
Range("H:H").ClearContents 'H oszlop törlése
Application.DisplayAlerts = False
End Sub -
#21541
Delila_1
veterán
lazlogogola
#21539
Delila_1
veterán
válasz
lazlogogola
#21539
üzenetére
Nem kell lista.
A betegek kr.xls-be írd be a képletet oda, ahova másolni akarsz.
=[2másolat.xls]krónikus!A1 ha a lap neve, ahonnan másolni akarsz, krónikus.
A képletet lemásolod a 300. sorig. -
#21537
Delila_1
veterán
lazlogogola
#21535
Delila_1
veterán
válasz
lazlogogola
#21535
üzenetére
Igen, a fájl nevét kiterjesztéssel, majd annak a lapnak a nevét, ahonnan másolsz.
A képletet lemásolva a többi sorban megkapod a 300 adatot. -
Delila_1
veterán
válasz
gobe22
#21530
üzenetére
Több lépésben lehet megoldani.
1. Kijelölöd a tartományt, a Szövegből oszlopok funkcióval oszlopokra bontod a szöveget, ahol határoló jelnek a vesszőt jelölöd be.
2. Újra kijelölöd a kibővült tartományt, Rendezés. Itt az Egyebek-nél a Balról jobbra funkciót választod.
3. Ezután újra összefűzöd az adatokat egy segédoszlopban, közöttük vesszővel: =A1 & "," & B1 & "," & C1 stb., ahány oszlopra bontotta szét a Szövegből oszlopok.
4. A segédoszlopot másolod, és az eredeti helyére illeszted be irányítottan, értékként.
5. Törlöd a feleslegessé vált oszlopokat, csak az A maradjon meg. -
#21532
Delila_1
veterán
lazlogogola
#21529
Delila_1
veterán
válasz
lazlogogola
#21529
üzenetére
=[InnenMásol.xlsx]InnenMásolLapneve!A1
Figyelj a kiterjesztésre!
-
#21528
Delila_1
veterán
sutyimatyi
#21525
Delila_1
veterán
válasz
sutyimatyi
#21525
üzenetére
Nincs jogosultságom a kép megtekintéséhez, de a lenti kép talán segít.
A B16, C16, és C18 cellák formátuma [ó]:pp.
-
Delila_1
veterán
válasz
PistiSan
#21526
üzenetére
A TRIM függvény levágja a hivatkozott cella elejéről és végéről a felesleges szóközöket.
=trim(B1)Az így kapott segédoszlop képleteket tartalmaz, ezért érdemes másolni, majd az eredeti helyére irányítottan, értékként beilleszteni.
Az eredmény szöveg típusú lesz, át kell alakítani számokká, így.
-
Delila_1
veterán
válasz
lenkei83
#21521
üzenetére
Próbálkoztam, de nem jön össze.
Sub lapok()
Dim lap%, szoveg$
For lap% = 1 To Worksheets.Count
If Right(Sheets(lap%).Name, 1) = "x" Then
szoveg$ = szoveg$ & Sheets(lap%).Name & """" & ","
End If
Next
szoveg$ = Left(szoveg$, Len(szoveg$) - 2)
Sheets(Array(szoveg$)).Select
End SubAz utolsó sornál túlcsordulást jelez. Talán kiindulásnak jó.
-
Delila_1
veterán
válasz
alfa20
#21517
üzenetére
Csak egy apró egyszerűsítés.
Sub keres()
Dim keres As Variant, cim
keres = InputBox("Keresendő szöveg, szám:", "Keresés")
cim= Cells.Find(What:=keres, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Address
MsgBox cim
End Sub
oszlopot adom meg, akkor a tartományt fixen kell megadni, erre szolgálnak a $ jelek.
Új hozzászólás Aktív témák
Hirdetés
Fferi50- 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...
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Vírusirtó, Antivirus, VPN kulcsok
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- BESZÁMÍTÁS! Gigabyte B760M i7 12700K 16GB DDR4 512GB SSD RX 6700 XT 12GB Rampage SHIVA Enermax 750W
- Az ASUS TUF Gaming B550-Plus csak rád vár! Kamatmentes rèszletre is!!
- DUPLA XEON GOLD 6134!!! HP Z8 G4 LEGNAGYOBB WORKSTATION 64GB 2x8 mag 2x16 szál gamer, szerver, munka
- AKCIÓ! Gigabyte H510M i5 10400F 16GB DDR4 512GB SSD GTX 1070 8GB Rampage SHIVA Zalman 600W
- BESZÁMÍTÁS! ASUS TUF Z390-PRO GAMING alaplap garanciával hibátlan működéssel
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged