-
Fototrend
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
-
Pakliman
tag
válasz
twingos
#37659
üzenetére
Szia!
Én létrehoztam egy új munkafüzetet.
Abban létrehoztam 25 munkalapot (a neveik sorban: Munka1, Munka2, stb. Munka25)
AzIf Mid(ws.Name, 6) >= 1 And Mid(ws.Name, 6) <= 20 Thensor ezeknek a neveknek megfelelően ellenőriz. Ha nálad nem ezek a nevek vannak (gyanítom
), akkor más szisztéma szerint kell megtalálnod, hogy az a munkalap kell-e neked (Pl.: egy Select Caseválogatás).
Szerintem itt lesz a gond egyébként
Ha leírod a figyelendő munkalapok neveit, akkor tudok többet segíteni.A munkalapok kijelölését azért nem láthatod, mert egyrészt "gyors" a program, másrészt pedig a progi végén visszaállítom az eredetileg aktív (
Set wsA = ActiveSheet) munkalapot (wsA.Select). -
Pakliman
tag
válasz
Fferi50
#37657
üzenetére
Ez igaz.
Viszont mivel az "I3 cella értéke nullánál nagyobb" meghatározás számot feltételez, ezért valójában inkább még egy ellenőrzést kellene beépíteni:If IsNumeric(Ws.Range("I3")) then.
Mivel lehet ott egy éppen hibát jelző függvény is.
Sajnos az "egyszerűsítés" nálam nem mindig működik, sokszor futok (időnként rejtett) hibára
-
Pakliman
tag
válasz
twingos
#37653
üzenetére
Szia!
Egy lehetséges megoldás...
Public Sub qa()
Dim wsA As Worksheet: Set wsA = ActiveSheet
Dim wsArr
Dim wsDb As Integer
Dim ws As Worksheet
ReDim wsArr(0 To 0)
'Van egy táblázatom, ami 25 sheet-et tartalmaz. Nekem csak a 1-től 20. oldalig fontosak...
For Each ws In Worksheets
If Mid(ws.Name, 6) >= 1 And Mid(ws.Name, 6) <= 20 Then 'itt kell azonosítani a munkalapot, hogy kell-e egyáltalán
'ha az I3-as cella értéke nem üres...
If Not IsEmpty(ws.Range("I3")) Then
'... és nullánál nagyobb...
If ws.Range("I3") > 0 Then
wsDb = wsDb + 1
ReDim Preserve wsArr(1 To wsDb)
wsArr(wsDb) = ws.Name
End If
End If
End If
Next ws
If wsDb > 0 Then
Sheets(wsArr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="d:\Ez az új.pdf"
End If
wsA.Select
End Sub -
Pakliman
tag
Szia!
Kipróbáltam ("A" oszlopra), működik, csak az
.AutoFilterMode = Falsesort egy kicsit átalakítani (legalábbis nálam hibát dobott):.Parent.AutoFilterMode = False.
Így lefutott és törölt is.With Cells
.Parent.AutoFilterMode = False
.Range("a1:a1").AutoFilter 'Filter bekapcsolása
.Range("a1:a1").AutoFilter Field:=1, Criteria1:="OK" 'Kritérium megadása
.Range("A2:bb1000000").SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Kritériumnak eleget tevő cellák törlése
Cells.AutoFilter 'Filter törlése
Range("A1").Select 'Alap kiindulópont beállítása
Application.CutCopyMode = False 'Kijelölés megszüntetése
MsgBox ("Ok")
End With -
Pakliman
tag
válasz
cskata0513
#37045
üzenetére
Szia!
[Ezt] tanulmányozd át.
Az adatok összekeverve, hogy ne lehessen senkit se felismerni (azért vannak benne idióta nevek
).Hirtelenjében csak a data.hu-ra tudtam feltölteni telefonon keresztül (cégnél tiltott a data), remélem működik a letöltés...
-
Pakliman
tag
válasz
FoxiestFox
#37003
üzenetére
Infó [ITT] (többek között...)
Persze ez nem igazi SDI, de legalább a win tálcáján mindegyik munkafüzet megjelenik (ha a tálca is "úgy akarja").
A 2013-as már "valódi" SDI (ha jól tudom). -
Pakliman
tag
válasz
p5quser
#36959
üzenetére
Szia!
Nem próbáltam ki, mert dokinál vagyok, de mennie kellene:Sub CommandButton2_Click()
'Kijelölés
Dim ws as worksheet
Dim act as worksheet
Set act=activesheet
For each ws in worksheets
If not ws is act then
Ws.activate
Ws.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlAnd
Ws.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Ws.ShowAllData
Ws.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:="<-1", _
Operator:=xlAnd
Ws.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Ws.ShowAllData
Ws.Range("$A$1:$N$316").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlOr, Criteria2:="<-1"
Endif
Next ws
End Sub
(Baromi nehéz telefonon írni ) -
Pakliman
tag
válasz
csferke
#36925
üzenetére
Hali!
Réges-régen nekem is voltak gondjaim ezzel a CHDIR-es dologgal, úgyhogy hanyagolom azóta.
Ez egyébként is egy "DOS-os" dolog, akkor használd, ha nosztalgiázni van kedved
Bármit is szeretnél azokkal a mappákkal/fájlokkal, másképp sokkal egyszerűbben meg tudod oldani.
Pl.: munkafüzet megnyitása aWorkbooks.Open-el, mentése aWorkbooks.Save/Workbooks.SaveAs-el, "szöveges" fájlok olvasása/írása azOpen myFile For Input/Output/Append As #1módszerrel, vagy a kicsit "bonyolultabb"Scripting.FileSystemObject-el, stb.De ha mégis inkább CHDIR, akkor:
(Hibakereséshez egy kicsit átalakítva a Tied)Sub utvonal()
Dim PathName As String
Dim PathFull As String
PathName = Left((ActiveWorkbook.Name), (Len((ActiveWorkbook.Name)) - 5))
PathFull = "g:\Google Drive\TRANSPORT\" & PathName
Debug.Print PathFull
Debug.Print ActiveWorkbook.Path
Debug.Print "Egyezés: " & PathFull = ActiveWorkbook.Path
MsgBox PathName
ChDrive "G"
ChDir PathFull
MsgBox ActiveWorkbook.Path
End Sub -
Pakliman
tag
válasz
RAiN91
#36789
üzenetére
Sub TEST()
Dim c As Range, r As Range
Dim output As String
Dim fn As String
Dim bOk As Boolean
Dim i As Long
For Each r In Range("B69:D1870").Rows
For Each c In r.Cells
output = output & "," & c.Value
Next c
output = output & vbNewLine
Next r
fn = "text"
bOk = False
Do
If Dir("D:\" & fn & ".txt") <> "" Then
i = i + 1
fn = "text" & i
Else
bOk = True
End If
Loop Until bOk
Open "D:\" & fn & ".txt" For Output As #1
Print #1, output
Close
End Sub -
Pakliman
tag
A DARABTELI ebben a felállásban az első találat esetén 1-et, második találat esetén 2-t stb. ad vissza eredményként.
Feltételes formázásban is működni kellene elvileg.
Amióta rátaláltam kényszerből erre a megoldásra (nagyon sokszor kell használnom), azóta egyszerűbb (?) az életem"majd megpróbálom végig gondolni"
Csak úgy tanul az ember...
[Ezen a képen] láthatod egy gyakorlati alkalmazását.
Az O és Q oszlopokban összesíti a dolgozók bizonyos teljesítményét, de mindenkinél csak az első előfordulásnál.Most vettem észre, hogy eredetileg nem is Neked szólt a válaszom, vagy csak a fórummotor szórakozik
-
Pakliman
tag
válasz
toth_janika
#36683
üzenetére
Fentről lefelé haladva megszámol(tat)od, hogy a megrendelő az oszlopban az adott SORIG ELŐZŐLEG hányszor szerepelt.
Ahol 1-nél nagyobb szám van, az a hunyó
-
Pakliman
tag
válasz
JagdPanther
#36601
üzenetére
Az
NRow = 4helyett meg kellene határoznod a jelenlegi utolsó sort:Pl.:
NRow = SummarySheet.Cells.Find(What:="*", _
After:=SummarySheet.Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlValues, _
SearchOrder:=xlByRows).RowA másolandónál:
Meghatározod a másolandó munkalap utolsó sorát, aztán:WorkBk.Worksheets(1).Range("A6:V" & LastRow).Copy(Biztos, hogy "A6"?)SummarySheet.Cells(NRow + 1, 1).PasteSpecial Paste:=xlPasteValues(ha csak az érték kell) -
Pakliman
tag
válasz
JagdPanther
#36601
üzenetére
Közben átnéztem a kódodat, az alábbi már tárgytalan...
[Ebben] a hozzászólásban van az utolsó használt sor ill. oszlop meghatározására használt makróm, próbáld ki.
NEM azonos a "SpecialCells()" metódussal! -
Pakliman
tag
válasz
fricc_
#36592
üzenetére
D oszlop elrejtve, a
Debug.Print n4-et ad visszaDim ws As Worksheet
Dim n As Integer
Dim cl As Range
For Each ws In ThisWorkbook.Worksheets
n = 0
For Each cl In .Rows(5).Columns
If cl.Hidden Then
n = cl.Column
Exit For
End If
Next cl
Debug.Print ws.Name & "->n=" & n
Next wsErre gondoltál?
-
Pakliman
tag
válasz
lenkei83
#36587
üzenetére
Akkor viszont:
Dim ws As Worksheet
Dim rCella As Range
Set ws = ActiveSheet
With ws
For Each rCella In .Range("I2:I" & .Range("A1").SpecialCells(xlCellTypeLastCell).Row)
rCella = "=sumifs('" & .Cells(rCella.Row, "F") & "'!$C:$C," & "'" & .Cells(rCella.Row, "F") & "'!$B:$B,$D2," & "'" & .Cells(rCella.Row, "F") & "'!$P:$P,$B2)"
Next rCella
End WithAzt ugye tudod, hogy a SpecialCells tud ám rafinált hibákat okozni?
Csak látszat, hogy az utolsó "használt" cella lesz az alapja a visszaadott koordinátának.
Ha az utolsó mentés (és/vagy újranyitás) előtt mondjuk a "XFD1048576" cellába (O2010-nél az utolsó cella) valaki írt valamit aztán TÖRÖLTE, akkor a SpecialCells(xlCellTypeLastCell) az a cella lesz!!Én ezeket használom az utolsó sor/oszlop meghatározására (a "hol" lehet egy munkalap, vagy akár egy terület is):
Public Function UtolsóSora(hol, Optional lColumn As Long = 1) As Long
Dim rng
Set rng = hol.Cells(hol.Cells.Rows.Count, lColumn)
If Not IsEmpty(rng) Then
UtolsóSora = rng.Row
Else
UtolsóSora = rng.End(xlUp).Row
End If
Set rng = Nothing
End Function
Public Function UtolsóOszlopa(hol, Optional lRow As Long = 1) As Long
Dim rng
Set rng = hol.Cells(lRow, hol.Cells.Columns.Count)
If Not IsEmpty(rng) Then
UtolsóOszlopa = rng.Row
Else
UtolsóOszlopa = rng.End(xlToLeft).Column
End If
Set rng = Nothing
End Function -
Pakliman
tag
válasz
lenkei83
#36585
üzenetére
Jelenlegi ismereteim szerint (remélem, lesz aki mutat valami jobbat) az INDIREKT nélkül csak úgy lehet megoldani, hogy a munkalap neve(ket)t fixen építed be a függvénybe. Így viszont "nincs értelme" az F oszlopnak, mivel nem is fogja onnan venni az értéket
Az INDIREKT valóban lassítja a dolgot, mivel volatile függvény, vagyis minden esetben újraszámol. -
Pakliman
tag
-
Pakliman
tag
válasz
Angerfis
#36561
üzenetére
Én annak idején úgy oldottam meg a problémát, hogy a "...a(z) Ne09: kimeneten" szöveg alapján egy ciklussal szépen végigmentem a számokon. Megnéztem, hogy létezik-e az a nyomtató, ha nem, akkor Next.
Valami ilyesmi volt (vagyis pont ez ):Public Const Pr_Beo As String = "\\primon\SZK901"
Public Const Pr_S_Munkaügy As String = "\\primon\SUV204"
Public Const Pr_S_Diszp As String = "\\F90001295\HPLJ4200"
Public Const Pr_F_Diszp As String = "\\primon\FKA204"
Public Const Pr_H_Diszp As String = "\\primon\HCN205"
Public Function Nyomtató_Váltás(Optional mire As String = Pr_Beo) As Boolean
Dim sorszám As Long
Dim Hiba As Boolean
Err.Clear
Hiba = True
On Error Resume Next
For sorszám = 0 To 99
Application.ActivePrinter = mire & " a(z) Ne" & Format(sorszám, "00") & ": kimeneten"
If Err.Number = 0 Then
Hiba = False
Exit For
End If
Next sorszám
Nyomtató_Váltás = Hiba
Err.Clear
End Function -
Pakliman
tag
válasz
szatocs1981
#36553
üzenetére
Egy lehetőség még, hogy segédoszlopban képlettel összefűzöd a cellákat (Pl.: =A2 & ":" & B2 & ":" & C2).
Ez után az FKERES-el tudsz keresgélni (Pl.: =FKERES("V2:4:P01";D:D;1;HAMIS)).
Makróval is működik.
Vagy:
Makróval "egyszerre" tudsz keresni az összes oszlopban a range.Find() és range.FindNext() metódusokkal.
Az első oszlopban keresed pl. a "V2"-t, találat esetén megnézed, hogy a 2. oszlopban 4 van-e, ha igen, akkor a 3. oszlopban "P01" van-e. Ha bármelyik kérdésre hamis a válasz, akkor FindNext...
Érdemes tanulmányozni ezeket (nem csak a Find miatt):
[www.ozgrid.com]
[Ron de Bruin oldala] -
Pakliman
tag
Hali!
Bár életemben nem használtam még az
Application.Callercuccot, de szinte biztosan hibás azX = Caller.Application.WorksheetFunction.Match.
Szerintem próbáld így:Application.WorksheetFunction.Match(...), vagyApplication.Match(...). Én az utóbbit használom.A kettő csak a "találatmentesség" esetén tér el.
Az előbbi azOn Error ..."hibakezelővel", az utóbbi azIsError(...)függvénnyel kezelhető. -
Pakliman
tag
Szia!
Ha ez egy folyamatosan bővülő lista és nem olyan, amivel csak most az egyszer kell bármit is csinálni, akkor a C oszlopba beírod: =A2 & " " & B2, a D oszlopba kerül az általam jelzett függvény (átalakítva):
=HA(DARABTELI(INDIREKT(CÍM(SOR();3)):$C$1000;C2)=1;C2;"")Ha csak most kell vele számolni, akkor lásd: [(#36485) Fferi50]
-
Pakliman
tag
válasz
Dark Archon
#36329
üzenetére
Szívesen
-
Pakliman
tag
válasz
Delila_1
#36325
üzenetére
Ismerem ezt a dolgot, csak azt bátorkodtam jelezni, hogy nem a makró lesz az, ami a tényleges megoldást hozza az ilyen emberek ellen, hanem az, ha ráveszik valamilyen formában, hogy igenis vegye tudomásul, más is szeretne (muszáj
) dolgozni az adott táblázaton, figyeljen oda jobban.
Én is rengeteget szívok az ilyen emberek miatt, csak sajnos az feletteseim sz..nak rá
Volt olyan, hogy a munkahelyi gépén megnyitotta, aztán elment haza! (a gépeket általában csak hétvégére kapcsoljuk ki).
Ezért tettem OFF-ba a hozzászólásomat
-
Pakliman
tag
válasz
Delila_1
#36323
üzenetére
Ez egy szuper megoldás... lenne... csak az a baj, hogy pont az ilyen emberek becsukják a laptopot stb. és a továbbiakban nem foglalkoznak vele.
Így viszont csinálhat bármit az excel, a munkafüzet bizony nyitva marad
Az automatikus mentés és kilépés vagy mentés nélkül kilépés viszont működhet felettesi engedéllyel (persze ezután jönnie kellene a renitens delikvens felelősségre vonásának). -
Pakliman
tag
válasz
Dark Archon
#36321
üzenetére
Szia!
A segédcella, amit majd szűrhetsz (a képlet értéke 0, ha egyik szó sem szerepel a cellában):
-
Pakliman
tag
válasz
Ada Wong
#36318
üzenetére
Szia!
Van rá "megoldás", de én (saját tapasztalat) nem ajánlom: ez a "Munkafüzet közössé tétele és védelme" (O2010 alatt így hívják a menüpontot.)
Kollégáimmal sokat szívtunk miatta, rendszeres volt a fagyás + adatvesztés (több ezer képletet tartalmazott), ezért egy idő után megegyeztünk a "ha a másik végzett, akkor jövök én" módszerben.Az elfelejti bezárni ellen csak szankcióval lehet védekezni
A Dropbox-ot nem ismerem (nálunk tiltva van), viszont a hálózatunkon lévőknél mindig jelzi, ha valakinél már meg van nyitva SZERKESZTÉSRE. Kiírja a felhasználó nevét is. Ennél több nem hiszem, hogy kell.
"- ha már meg van nyitva, ne kérdezzen rá, hogyan akarjuk megnyitni, hanem eleve csak olvasásra legyen hajlandó?"
VBScript-ből vagy egy saját makrókat tartalmazó munkafüzetből (ami minden excel indításkor betöltődik) kell indítani a munkafüzet megnyitását.
Pl.:Workbooks.Open fileName:=Mappa & "\Közösen használt.xlsm", ReadOnly:=Not bMárNyitvaVan -
-
Pakliman
tag
válasz
m.zmrzlina
#36295
üzenetére
"Természetesen a fájlokon valaki úgy dolgozik, hogy a hálózati meghajtóról nyitja meg és oda is ment, van aki a saját gépére másolja ott dolgozik rajta aztán másolja vissza, néha nem is ugyanabba a könyvtárba és nem is ugyanazon a néven mint amin levette."
Ha ez nem lenne, makróval még meg is lehetne oldani. De így...
Ha Te vagy a felelőse/"karbantartója" ennek a dolognak, akkor MEG KELL tiltanod/akadályoznod, hogy mindenki azt csináljon, amit akar.
Ha ezt nem teszed, marad a kézimunka
Bár így is működhet a makró, csak ez esetben a Te feladatod lesz a makró futásakor kiválasztani a szükséges munkafüzeteket. -
Pakliman
tag
válasz
föccer
#36241
üzenetére
A ThisWorkbook modul "Workbook_BeforeSave" eseménykezelőjébe kell beírni egy kódot.
Ez minden "mentés" esetén lefut, itt tudsz jelszót kérni és ha azt nem tudja az illető, akkor elhajtani a ...
Pl.:Const ValódiJelszó = "MentésiJelszó"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sPass As String
sPass = InputBox("Mi a jelszó?")
If sPass <> ValódiJelszó Then
Cancel = True
MsgBox "Nincs jogod menteni!!"
End If
End SubÉs persze magát a munkafüzetet és azon belül a VBA kódot is jelszóval védeni. A VBA kódnál nem engedjük meg a betekintést sem, hiszen akkor megtudná akárki a szükséges jelszót
-
Pakliman
tag
válasz
ben800
#36204
üzenetére
Úgy nagyjából valami ilyesmi...
Public Sub AdatMásolás()
Dim wbT As Workbook 'A "kis" munkafüzet, ami tartalmazza a...
Dim wsT As Worksheet '..munkalapokat (1-től 12-ig)
Dim cT As Long 'Számláló (a 19 db táblázathoz)
Dim usT As Long 'A kis táblázat utolsó sora
Dim aws As Worksheet 'Csak azért, hogy ne ActiveSheet legyen:)
Dim us As Long 'A FŐ táblázat utolsó sora
Dim sor As Long 'Egyszerű számláló
Dim talált 'A keresett azonosító cellacíme lesz
Set aws = ActiveSheet
For cT = 1 To 19
On Error GoTo Hiba
Set wbT = Workbooks.Open("a feldolgozandó kis táblázat neve útvonallal együtt")
For Each wsT In wbT.Worksheets
usT = wsT.Cells(wsT.Rows.Count, 1).End(xlUp).Row
For sor = 2 To usT 'Feltételezve, hogy az 1. sor fejléc
'Az azonosító az 1. oszlopban van
'!!! A FŐ táblában (aws) keressük a kis táblás azonosítót (wsT.Cells(sor, 1)) !!!
Set talált = aws.Columns(1).Find(What:=wsT.Cells(sor, 1), LookAt:=xlWhole, MatchCase:=True)
'Ha találtunk, akkor nem csinálunk semmit.
'Ellenben:
If talált Is Nothing Then
us = aws.Cells(aws.Rows.Count, 1).End(xlUp).Row
aws.Cells(us + 1, 1) = "azonosító"
aws.Cells(us + 1, 2) = "adat1"
aws.Cells(us + 1, 3) = "adat2"
aws.Cells(us + 1, 4) = "adat3"
aws.Cells(us + 1, 5) = "adat4"
aws.Cells(us + 1, 6) = "adat5"
'...
End If
Next sor
Next wsT
On Error GoTo 0
wbT.Close SaveChanges:=False
Next cT
Set wbT = Nothing
Set wsT = Nothing
Set aws = Nothing
GoTo Vége
Hiba:
'Hibakezelés, pl. ha nincs olyan fájl stb.
'Ha nem kell tenni semmit hiány esetén, akkor egyszerűen csak..
Resume Next
Vége:
End Sub -
Pakliman
tag
válasz
ben800
#36200
üzenetére
Szia!
A lényeg (egyben a megoldás kulcsa), hogy a "kis" táblákban a soroknak legyen egy egyedi azonosítója (ezt a felhasználónak nem is kell látnia).
Ha ez megvan, onnantól már pikk-pakk (meg még néhány sor VBA kóddal
) megoldható a dolog.
Ha nincs és nem is megoldható, akkor gáz van
-
Pakliman
tag
Sziasztok!
Ha valakinek esetleg kellene egy ilyen:
Public Function Darabolt(darabolandó, rész As Long, Optional elválasztó As String = " ", Optional elválasztó_egyben_használandó As Boolean = True) As String
Dim delim
Dim i As Long
If elválasztó_egyben_használandó Then
delim = elválasztó
Else
delim = Mid(elválasztó, 1, 1)
For i = 2 To Len(elválasztó)
darabolandó = Replace(darabolandó, Mid(elválasztó, i, 1), delim)
Next i
End If
On Error GoTo Hiba
Darabolt = Split(darabolandó, delim)(rész - 1)
Exit Function
Hiba:
Darabolt = ""
End FunctionHasználata:
darabolandó -> bármilyen szöveg, amiből egy részt akarunk visszakapni
rész -> az elválasztók által határolt n-edik rész
elválasztó -> ezt a karaktert vagy szöveget értelmezzük elválasztóként -> ha nincs megadva, akkor 1 db szóköz
elválasztó_egyben_használandó -> lásd lentebbDarabolt("A darabolandó szöveg-> kukac@excel.hu",2) -> "darabolandó"
Darabolt("A darabolandó szöveg-> kukac@excel.hu",4) -> "kukac@excel.hu"
Darabolt("A darabolandó szöveg-> kukac@excel.hu",1,"->") -> "A darabolandó szöveg"
Darabolt("A darabolandó szöveg-> kukac@excel.hu",2,"->") -> " kukac@excel.hu"Darabolt("A darabolandó szöveg-> kukac@excel.hu",1,"->",False) -> "A darabolandó szöveg"
Darabolt("A darabolandó szöveg-> kukac@excel.hu",2,"->",False) -> ""
Darabolt("A darabolandó szöveg-> kukac@excel.hu",3,"->",False) -> " kukac@excel.hu"Darabolt("A darabolandó szöveg-> kukac@excel.hu",3,"->@",False) -> " kukac"
Darabolt("A darabolandó szöveg-> kukac@excel.hu",4,"->@",False) -> "excel.hu"Darabolt("A darabolandó szöveg-> kukac@excel.hu",1,"->@",True) -> "A darabolandó szöveg-> kukac@excel.hu"
Használható VBA-ban és cellában egyaránt.
-
Pakliman
tag
válasz
attilalr2
#35171
üzenetére
Szia!
Ezt a DARABTELI függvénnyel meg tudod oldani.
Segédoszlopot célszerű alkalmazni, amiben 1 vagy 0 értéket ad a függvény attól függően, hogy az adott sorban a 2 szám együtt szerepel-e:=HA(ÉS(DARABTELI(A1:E1;1)=0;DARABTELI(A1:E1;2)=0);1;0)
Esetleg 2 cellát is használhatsz, amibe a keresendőket írod, így bármikor változtathatod.
Ekkor pl::
=HA(ÉS(DARABTELI(A1:E1;$G$1)=0;DARABTELI(A1:E1;$H$1)=0);1;0)A SZUM()-al összesítheted.
-
Pakliman
tag
válasz
the radish
#35165
üzenetére
Szia!
Ezt "kényszerből" írtam, mert sokszor volt/van szükségem darabolásra.
Használható cellában és makróban egyaránt.Public Function Darabolt(darabolandó, rész As Long, Optional elválasztó As String = " ", Optional elválasztó_egyben_használandó As Boolean = True, Optional trim As Boolean = True) As String
Dim delim
Dim s
Dim i As Long
s = IIf(trim, Application.Trim(darabolandó), darabolandó)
If elválasztó_egyben_használandó Then
delim = elválasztó
Else
delim = Mid(elválasztó, 1, 1)
For i = 2 To Len(elválasztó)
s = Replace(s, Mid(elválasztó, i, 1), delim)
Next i
End If
On Error GoTo Hiba
Darabolt = Split(s, delim)(rész - 1)
Exit Function
Hiba:
Darabolt = ""
End FunctionHasználata:
darabolandó= "dara bolandó napok"
rész= lásd eredményeknél
elválasztó= " n" 'ha nem adod meg, akkor 1 db szóköz
' elválasztó_egyben_használandó= ha nem adod meg, akkor IGAZ
' trim= ha nem adod meg, akkor IGAZ
elválasztó_egyben_használandó= HAMIS (=a szóköz is és az n is elválasztóként használandó)
trim= HAMIS (=feldolgozás előtt a dupla/tripla stb szóközöket NEM cseréli 1 db szóközre)
eredmény rész=1 --> "dara"
eredmény rész=2 --> ""
eredmény rész=3 --> ""
eredmény rész=4 --> ""
eredmény rész=5 --> ""
eredmény rész=6 --> "bola"
eredmény rész=7 --> "dó"
eredmény rész=8 --> ""
eredmény rész=8 --> "apok"
'-------------------------------------------------
darabolandó= "dara bolandó napok"
elválasztó= " n"
elválasztó_egyben_használandó= IGAZ (=KIZÁRÓLAG a " n" sztring az elválasztó!!)
trim= IGAZ (=feldolgozás előtt a dupla/tripla stb szóközöket kicseréli 1 db szóközre)
eredmény rész=1 --> "dara bolandó"
eredmény rész=2 --> "apok" -
Pakliman
tag
Szia!
Az táblázat megnyitása (a tulajdonképpeni "program" elindítása) nélkül ez nem megy
Viszont van kerülő út, pl.:
- a win. indítópultjába berakod, így az a gép (újra)indításakor megnyílik, a program lefut. Hátránya, hogy bezárni Neked kell
- VBScript, időzítő programok használata...Hogy csak egyszer lehessen futtatni:
Makró kell.
Ki kell választani egy cellát valamelyik munkalapon (lehet egy kimondottan erre létrehozott, esetleg rejtett!).
Ez lesz a CheckDate...
A lekérdezést/másolást végző makró elejére kell beírni egy kódot, ami ellenőrzi, hogy a CheckDate cella tartalma mi: ha üres vagy a mai napnál régebbi dátum szerepel benne, akkor mehet tovább a feldolgozás,
egyébként esetleg MsgBox a júzernek, hogy ma már nem futhat... -
Pakliman
tag
válasz
huliganboy
#33338
üzenetére
Szia!
Így valamivel gyorsabb lesz:
Sub Nagy_Kezdőbetű()
'Letiltjuk a cellák újraszámolását és a képernyő frissítését
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' A megadott tartomány összes celláján végrehajtja a ciklust.
For Each x In Range("D3:AD20000")
' A Microsoft Visual Basic for Applications (VBA) alkalmazásban nincs nagy kezdőbetűs függvény.
' Ezért a munkalapfüggvényt kell használnia a következő módon:
'Az átalakításból eleve kizárjuk az üres és a nem szöveget tartalmazó cellákat
If (Not IsEmpty(x)) And (Not IsNumeric(x)) Then
x.Value = Application.Proper(x.Value)
End If
Next
'Engedélyezzük a cellák újraszámolását és a képernyő frissítését
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub -
Pakliman
tag
válasz
zakoss
#33282
üzenetére
Szia!
"És ez egy olyan excel fájl lenne amiben folyamatosan dolgoznának, de sajnos rettentően
dühítő ezzel dolgozni."Ez vajon azt jelenti, hogy az egy "megosztott" munkafüzet?
Ha igen, akkor az szívás, nálam legalábbis az volt
Olyan mértékű volt a belassulása, hogy inkább lemondtunk róla.
Nem csak lassú volt, de időnként össze is omlott, adatvesztésünk is volt miatta.
Az egyetlen megoldás az volt (az átalakítása nem jött be, nem szűnt meg a probléma), hogy üres munkafüzetben újonnan kellett létrehozni minden munkalapot, minden formázást, képletet stb.
A másolás/beillesztés valamiért "vitte magával" a problémákat is.
(Magyar Office Professional Plusz 2010 v14.0.7173.5000 SP2)Ha nem ez, akkor esetleg feltételes formázás hegyek?
-
Pakliman
tag
válasz
lenkei83
#33032
üzenetére
Szia!
Ha nem akarsz csiki-csukit, akkor az rw változót a proc elején deklaráld és minden
Print #xx,sor után írd be ezt:rw=rw+1.
A végén az rw értéke a fájl sorainak a száma lesz (feltéve, hogy a fájlba kiírt szövegek nem tartalmaznak sortörést okozó karaktert).Vagy egy másik lehetőség, hogy az
Open ...esetében a Random-t használod az Output helyett. -
Pakliman
tag
válasz
lenkei83
#33026
üzenetére
Szia!
Csak egy pillantást tudtam vetni rá, de szerintem a hiba
For Output As #xxlesz.
Ez esetben olvasni nem tudsz a fájlból.Egy lehetőség a sok közül:
For Each mezokod In mezokod_tartomany_1
If mezokod <> "" And mezokod.Offset(0, -6) <> "" Then
Print #xx, mezokod.Value & "=" & mezokod.Offset(0, -6).Value
End If
Next mezokod
Close #xx 'ÚJ SOR!!
Dim LineofText As String
Dim rw As Long
rw = 0
xx = FreeFile() 'ÚJ SOR!!
Open ThisWorkbook.Path & "\" & "1665" & "_" & ido & ".imp" For Input As #xx 'ÚJ SOR!!
Do While Not EOF(xx)
Line Input #xx, LineofText
rw = rw + 1
Loop
MsgBox rw
Close #xxAz 'ÚJ SOR!! részeket kell beírnod a kódba.
Figyelj! Az Open-nél Input van!Remélem műxik majd
-
Pakliman
tag
válasz
butch3r
#33016
üzenetére
Szia!
Sajnos már én is jártam így
Milliószor töröltem a sorokat, mentés, megnyitás, és az excel még mindig baromi sok sort "érzékel"
A megoldás az volt, hogy új munkalap vagy munkafüzet létrehoz, szükséges adatokat tartalmazó terület kijelöl, újba átmásol, ment, régi kidob ÉS -
Pakliman
tag
válasz
Sprite75
#32881
üzenetére
Szia(sztok)!
"Elegánsabb" megoldás, de kell a VBA:
Public Function MyÖsszefűz(terület As Range, Optional elválasztó As String = ";") As String
Dim cella As Range
Dim temp
For Each cella In terület
If cella <> "" Then temp = temp & IIf(temp <> "", elválasztó, "") & cella
Next cella
MyÖsszefűz = temp
End Function
-
Pakliman
tag
válasz
attilalr2
#28000
üzenetére
Hali!
Nem tudom, Nálad milyen kódolás van.
A munkahelyemen spec. program TXT kimenetét kellett átalakítanom olvashatóbbá.
A makró (standard modulba rakod):Private Declare Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
Private Declare Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
Public Function Konvert(mit, Optional KellKonvertálni As Boolean = True) As String
Dim vissza As Long
Dim dest As String
If KellKonvertálni Then
dest = Space(Len(mit))
vissza = OemToCharBuff(mit, dest, Len(mit))
Else
dest = mit
End If
Konvert = dest
End FunctionEzt használhatod cellába beírva, vagy akár egy újabb makróban is, amelyik végigfut a szükséges cellákon és átalakítja a tartalmukat.
), akkor más szisztéma szerint kell megtalálnod, hogy az a munkalap kell-e neked (Pl.: egy 
) megoldható a dolog.
Új hozzászólás Aktív témák
- PC Game Pass előfizetés
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- 2db Kolink kontinium 1200w platinum
- BESZÁMÍTÁS! 1TB Samsung 870 QVO 2,5" SATA SSD meghajtó garanciával hibátlan működéssel
- Készpénzes / Utalásos Videokártya és Hardver felvásárlás! Személyesen vagy Postával!
- 186 - Lenovo Legion 5 (15IRX10) - Intel Core i7-13650HX, RTX 5070 (ELKELT)
- Új Apacer 16GB DDR4 3200MHz
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest