-
IT café
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
Topikgazda
válasz slashing #23400 üzenetére
Azért egy másik, ami azt figyeli, hogy a saját felhasználói neveddel léptél-e be.
Sub mmmm()
Dim nev$
nev$ = Application.InputBox("Add meg a neved!", "Név bekérése", , , , , , 2)
If nev$ <> Environ("username") Then
MsgBox ("Te kis huncut, nem vagy jogosult a füzetet használni!"), vbOKOnly + vbExclamation
Exit Sub
Else
MsgBox "Tovább..."
'makró többi része
End If
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
Nah találtam valamit a regexp-re
engedélyezni kell az editorban a Tool/References/ a Microsoft VBScript Regular Expressions 5.5-ötcsak a .Pattern részét írtam át ami úgy tűnik hogy hogy vezeték és keresztnév legyen szóközzel elválasztva JÓ bár a csak szóközre is jó még. Egy megfelelő patternel ez már kiküszöbölhető.
Sub nevellenorzes()
Dim Done As Boolean
Dim S As String
Dim RegEx As RegExp
Set RegEx = New RegExp
Do Until Done
S = Application.InputBox("Add meg a nevet:")
With RegEx
.Pattern = "([a-zA-Z]*)\s([a-zA-Z]*)"
Done = .Test(S)
End With
Loop
MsgBox S, vbOKOnly
End Sub[ Szerkesztve ]
-
slashing
senior tag
a \w{3,}\s\w{3,} lenne a legjobb pattern ha nem lenne ékezet a nyelvünkben de mivel van így szívás az egész úgyhogy abbahagyom, ma nem is akartam már semmit csinálni az excelben erre reggel óta szórakozok vele
-
Wyll
őstag
Szaisztok!
Vannak-e az excel vba-nak filekezelő függvényei?
Szeretnék egy makrót, ami:
- leellenőrzi, hogy egy bizonyos nevű file létezik-e már,
- ha igen, akkor megnyitja
- ha nem, akkor ilyen néven hozzon létre egy file-t, és azt nyissa meg
(utóbbi műveletet inkább úgy kéne megvalósítani, hogy egy már biztosan létező alapfile-t nyit meg, amiben kitölt pár értéket, majd mentés másként, pont a megadott néven.)Szóval ezt meg lehet csinálni?
Ha igen, akkor ehhez a fontosabb parancsokat le tudná valaki írni nekem?Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=Wyll
-
bteebi
veterán
Sziasztok!
Van több munkalapon néhány táblázat, amikben bizonyos cellák kék hátterűek (RGB kód: 141, 180, 226). Ezeket a cellákat kellene kigyűjtenem egy külön lapra ("Összefoglaló") bizonyos elnevezési szabály alapján. A kép alapján érthető(bb) lesz.
Vegyük mondjuk a C12-es cellát. Kék hátterű, és úgy kellene kiírni az "Összefoglaló" lapra (a C2-es cellától kezdve lefelé), hogy Város 1 - 20150106 - du.; a többi kék cella ennek az analógiájára lenne elnevezve.
A munkafüzetben nagyon sok munkalap van, és csak a "Lista" névvel kezdődőeknél vannak ilyen cellák, ezért összességében felgyorsítaná a folyamatot, ha csak ezeket a lapokat nézné végig a makró.
Egyelőre eddig jutottam, de minden bizonnyal több hiba is van benne. Tudnátok segíteni a kijavításában?
Sub osszeir()
Dim ws As Worksheet, i As Integer, j As Integer, cella As Range
j = 2
For i = 1 To Worksheets.Count
If Left(ws.Name, 5) = "Lista" Then
ws.Activate
For Each cella In ActiveSheet.UsedRange
If cella.Interior.Color = RGB(141, 180, 226) Then
Sheets("Összefoglaló").Cells(j, 3).Value = Cells(5, cella.Column) & " - " & Cells(cella.Row, 1) & " - " & Cells(6, cella.Column)
j = j + 1
End If
Next
End If
Next i
End SubCancel all my meetings. Someone is wrong on the Internet.
-
Delila_1
Topikgazda
Sub megnyit()
Dim FN As String
FN = "MegadottNev.xlsm"
On Error GoTo Nyit
Workbooks.Open "C:\Temp\proba.xlsx"
On Error GoTo 0
GoTo Folytatas
Nyit:
Workbooks.Open "C:\Temp\alapfile.xlsx"
On Error GoTo 0
Folytatas:
'Ide jön a pár adat kitöltése
'mentés a megadott mappába, az FN változóban megadott névvel
ActiveWorkbook.SaveAs Filename:="C:\Temp\" & FN, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Fferi50
őstag
válasz bteebi #23407 üzenetére
Szia!
"For i = 1 To Worksheets.Count
If Left(ws.Name, 5) = "Lista" Then"Hol adod meg a ws értékét?
Helyette: For each ws in activeworkbook.worksheets
if left(ws.name,5)="Lista" then" ws.Activate
For Each cella In ActiveSheet.UsedRange"Nem kell aktívvá tenni a munkalapot, hogy tudj vele dolgozni.
Helyette: For Each cella in ws.usedrangeViszont akkor e helyett " Sheets("Összefoglaló").Cells(j, 3).Value = Cells(5, cella.Column) & " - " & Cells(cella.Row, 1) & " - " & Cells(6, cella.Column)"
ezt kell írnod: Sheets("Összefoglaló").Cells(j, 3).Value = ws.Cells(5, cella.Column) & " - " & ws.Cells(cella.Row, 1) & " - " & ws.Cells(6, cella.Column)
A végén levő next i helyett pedig sima next (az első for each bezárására).
Üdv.
-
Delila_1
Topikgazda
válasz bteebi #23407 üzenetére
Teljesen jó lenne (szemre, nem próbáltam ki), ha nem lennének az 5. sorban összevont cellák.
Javaslom, hogy a 4. sorban minden cellába írd be a Város 1-et, Város 2-t, stb. Itt a karakterek színe egyezzen meg a háttér színével, és erre az új sorra hivatkozz. El is rejtheted a 4. sort.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
m.zmrzlina
senior tag
Vagy nézd meg ezt:
Sub vaneilyen()
Dim File As String
File = InputBox("Add meg a keresett fájl nevét! (kiterjesztéssel együtt)")
Dim DirFile As String
DirFile = ThisWorkbook.Path & "\" & File
If Dir(DirFile) = "" Then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=DirFile
'vagy
'Workbooks.Open Filename:=másikfájl
'kitölteni a megfelelő adatokkal
'és menteni a kívánt néven
Else
Workbooks.Open Filename:=DirFile
End If
End SubEz a kód ebben a formájában abban a mappában keres amiben a kódot tartalmazó munkafüzet van.
-
Wyll
őstag
válasz m.zmrzlina #23412 üzenetére
köszönöm, ezt is megnézem - majd holnap
köszi szépen!Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=Wyll
-
.OM.
aktív tag
Szervusztok,
Van egy szép nagy táblázatom feltételes formázással színezve.
Egy másik táblázatot szeretnék kifesteni pontosan ennek a mására, de ott nincsenek értékek, nem teljesül semmilyen feltétel.
Hogyan tudom csak a színeket átmásolni? Formázás beillesztése pl nem működik, mert nincs érték amit formázzon. Nekem bután csak a kitöltés színeket kéne rátenni egy üres fülre.
Köszi előre is,
.om.ex .Oldman.
-
bteebi
veterán
válasz Fferi50 #23410 üzenetére
Nagyon köszönöm a segítséged , már majdnem jó .
Sub osszeir()
Dim ws As Worksheet, i As Integer, cella As Range
i = 2
For Each ws In ActiveWorkbook.Worksheets
If Left(ws.Name, 5) = "Lista" Then
For Each cella In ws.UsedRange
If cella.Interior.Color = RGB(141, 180, 226) Then
Sheets("Összefoglaló").Cells(j, 3).Value = ws.Cells(5, (cella.Column \ 2) * 2) & " - " & ws.Cells(cella.Row, 1) & " - " & ws.Cells(6, cella.Column)
i = i + 1
End If
Next
End If
Next
End SubA Sheets("Összefoglaló").Cells(j, 3).Value = ws.Cells(5, (cella.Column \ 2) * 2) & " - " & ws.Cells(cella.Row, 1) & " - " & ws.Cells(6, cella.Column) sornál akad el, "Application-defined or object-defined error"-ral. Sajnos nem megy se ws-sel, se anélkül.
#23411: Neked is köszönöm Delila . Az összevont cellás részt egyébként megoldottam így: (cella.Column \ 2) * 2. A "\" (mint újonnan ismét megtanultam) egész osztást végez, a mod (ezt is el szoktam felejteni) pedig a maradékos osztás maradékát adja meg. Például 14\3 = 4, 14 Mod 3 = 2.
Cancel all my meetings. Someone is wrong on the Internet.
-
Fferi50
őstag
Szia!
Szerintem ez elég bonyolult makróval oldható meg csak, mivel a feltételes formázás feltételeit kell megvizsgálnod, hogy az adott cellára melyik teljesült.
Makróban pl. a cells(1,1).formatconditions(x).interior.color adja meg a szín számát, ahol
cells(1,1) az A1 cella, formatconditions(x) az x-edik feltételes formázás. Hogy hány feltételes formázás van az adott cellánál, azt pedig a cells(1,1).formatconditions.count eredménye adja meg.
De a feltételes formázásnak sok egyéb tulajdonsága is van még, amiket mind meg kellene nézni, hogy teljesül-e a cellára (típusa, a tipustól függően a hozzá tartozó kifejezés, operátor....).
Én most nem vállalkoznék egy ilyen makró megírására....Üdv.
-
m.zmrzlina
senior tag
Nekem ezzel a kóddal sikerült lemásolnom (Excel 2010 alatt) egy korábbi munkalapon a feltételes formázás színeit:
Sub masol()
For Each cella In Selection.Cells
cella.Offset(0, 10).Interior.Color = cella.DisplayFormat.Interior.Color
Next
End SubEz a kód a kijelölt tartomány minden cellájának (feltételesen és nem feltételesen formázott) színét 10 oszloppal jobbra másolja.
Ja innen loptam, kipróbáltam és működött. (jsmith4892002 2012 aug 19.-i hozzászólása)
[ Szerkesztve ]
-
Fferi50
őstag
válasz m.zmrzlina #23418 üzenetére
Szia!
Ez a kód 2010-es verziótól jó. Korábbi verziókban nem működik.
Üdv.
-
Excelbarat
tag
válasz m.zmrzlina #23420 üzenetére
Színezésre egy másik megoldás (sajnos nem tudom, h korábbi verziónál működik-e):
Sub szinez()
Dim r
Dim g
Dim b
Dim i
For i = 1 To 5
r = Range("A" & i).Interior.Color Mod 256
g = (Range("A" & i).Interior.Color Mod 256 ^ 2) \ 256
b = Range("A" & i).Interior.Color \ 256 ^ 2
Range("C" & i).Interior.Color = RGB(r, g, b)
Next i
End SubAz "A" oszlop 1sorától az 5-ig a színeket átmásolja a "C" oszlop ugyan ezen soraiba.
Ha esetleg valaki makróval akar színezni diagramm oszlopokat így lehet (nálam épp ehhez kellett ):
ActiveSheet.ChartObjects("chart1").Activate
ActiveChart.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(r, g, b)Üdv,
Excelbarát -
m.zmrzlina
senior tag
válasz Excelbarat #23421 üzenetére
Ezzel a megoldással csak egy probléma van. Az eredeti kérdés az volt, hogy hogyan lehet feltételesen formázott cellák háttérszíneit lemásolni. Arra pedig ez a kód nem jó.
Amúg szép, ha megengeded használni fogom.
Ha már szinek:
Két rendszergazda beszélget:
-Na milyen az új barátnőd?
-Ne is kérdezd tökéletes. Csúcs ahogy kinéz. 90-60-90
-Nebasz!!! Sötétlila???? -
.OM.
aktív tag
válasz m.zmrzlina #23418 üzenetére
Köszönöm kedves Hóember!
Ha jól értem, ez 10 oszloppal jobbra teszi be a színeket - remekül működik, köszi!
Szerinted ki lehet tenni vágólapra és utána én választhatom meg, hogy vol legyen?
Esetleg egy új "colors" fülre A1-től beilleszteni?..arra már rájöttem, hogy nem egész oszlopot kell kijelölni, mert az kicsit megfogja a gépet..
Köszi,
.om.ex .Oldman.
-
Mittu88
senior tag
Azt hogy lehet megcsinálni, hogy ha ráállok egy cellára, egy változó eltárolja az értékét, és ha megváltoztatják, egy másik változó eltárolja az új értékét?
A SelectionChange-be meg tudtam oldani, hogy a régit tárolja egy globális változó, a Worksheet_Calculate-be meg az újat akartam, de ha ENTER-rel vagy TAB-bal változtatják meg a cella értékét, akkor annak a cellának az értékét tárolja, amelyikRE ugrott enter-rel vagy tab-bal.
-
m.zmrzlina
senior tag
Ugye a legprofibb megoldás gondolom az lenne, hogy egy változóba kiírkálni a cellák DisplayFormat.Interior.Color tulajdonságát majd egy újonnan létrehozott munkalapon visszaírni.
Vagy a másik, hogy ha van elég hely a munkalapodon akkor annyi oszloppal jobbra (vagy sorral lejjebb) másolni a formátumot ahol már nem zavar aztán Ctrl+C > formátum másolása az új munkalapra.
Nyilván te is észrevetted, hogy annyit sántít a megoldás, hogy a nofill (nincs kitöltés) hátterű cellákból fehér (colorindex 2) hátterű cellák lesznek. Nem tudom ez mennyire baj.
-
.OM.
aktív tag
válasz m.zmrzlina #23425 üzenetére
Sajnos pont egy bitang nagy riport közepén vannak a kérdéses színek, és minden irányban változó, hogy hol lenne szabad hely. A fehér szín nem okoz gondot, csak a buta színeket kell ráhúznom más adatokra.
..marad a 220 oszloppal keletre tolás és a lefestés utólag.Végül is megoldódott, köszi
ex .Oldman.
-
m.zmrzlina
senior tag
Próbáld ki ezt! Szerintem közel van ahhoz amit szeretnél. Úgy indítasz, hogy kijelölöd azt a tartományt aminek a szineit másolni szeretnéd és elindítod a makrót.
Sub masol()
Dim intSorok As Integer
Dim intOszlopok As Integer
Dim arrCopyColor()
intSorok = Selection.Rows.Count
intOszlopok = Selection.Columns.Count
ReDim arrCopyColor(intSorok, intOszlopok)
For i = 0 To intSorok
For j = 0 To intOszlopok
arrCopyColor(i, j) = Cells(ActiveCell.Row + i, ActiveCell.Column + j).DisplayFormat.Interior.Color
Next
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "colors"
For i = 1 To intSorok
For j = 1 To intOszlopok
Cells(i, j).Interior.Color = arrCopyColor(i, j)
Next
Next
End Sub[ Szerkesztve ]
-
lappy
őstag
Sziasztok!
Van egy táblázatom amiben ügyeleti beosztás van. Több név ami többször előfordulhat.
A következőt szeretném:
- amikor megnyitom a fájlt akkor kérje be a nevet (Ok gomb ha megadta- addig szürke legyen)
- ha nincs ilyen név akkor írja ki hogy " Nincs beosztva"
- ha van találat akkor azoknak a celláknak a háttér színét emelje ki vmilyen színnel vagy olyat lehet hogy csak azok a nevek maradjanak amit éppen beírtak ( a többi eltűnik) ? (de gondolom az első megoldás könnyebb)
- olyat lehet-e hogy kiírja a megadott név melyik nap melyik teremben ill. mettől - meddig ügyel??Bámulatos hol tart már a tudomány!
-
bteebi
veterán
- amikor megnyitom a fájlt akkor kérje be a nevet (Ok gomb ha megadta- addig szürke legyen)
- ha nincs ilyen név akkor írja ki hogy " Nincs beosztva"Szerintem jobb lenne, ha begépelés helyett inkább egy legördülő lista lenne, ahol mindenki kiválaszthatja a saját nevét. Ha be kell gépelni, akkor hibázni fognak, ráadásul kevésbé kényelmes. A begépeléshez egy mezei InputBoxra lenne szükséged, a legördülő lista viszont valamelyest macerásabb, ahhoz UserForm kell ComboBoxszal.
Cancel all my meetings. Someone is wrong on the Internet.
-
m.zmrzlina
senior tag
válasz Mittu88 #23432 üzenetére
Kijelölt cella értékének változóba írása:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek1 = Target.Value
End If
End SubMódosított cellaérték változóba írása:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek2 = Target.Value
End If
End Sub -
Fferi50
őstag
Szia!
Csinálsz egy un. "belépő" lapot. Amikor belép a felhasználó, csak ezt látja.
Egy cellát "kinevezel" felhasználónak ezen a munkalapon. Ehhez rendeled adatérvényesítéssel (adatok - érvényesítés - lista) a lehetséges belépők listáját - amit tehetsz egy elrejtett munkalapra, vagy az adott munkalap nem látható/elrejtett oszlopába.
Amikor belép,csak ez a "belépő" munkalap látszik, a legördülő listából kiválasztja magát. Ha ez megtörtént, megmutatod neki az ügyeleti beosztást. Ha nem választ a listából, akkor csak a "belépő" lapot látja továbbra is. (A nem választást úgy figyelheted, hogy adsz egy "semleges" értéket a lista elejére (pl. Válassz), ami megjelenik belépéskor. Ha a cella értéke ez, akkor még "nem lépett be".Üdv.
-
.OM.
aktív tag
válasz m.zmrzlina #23429 üzenetére
Szia,
Csúcs, de az 1. sort nem viszi.. Tehát a 2. sor színe megy az 1. sorba az új fülön.
Mindegy, mert a címsort nem kell színezni, a végén majd azt beszúrom...+1 #pirospont m.zmrzlina részére
[ Szerkesztve ]
ex .Oldman.
-
m.zmrzlina
senior tag
Két kérdés:
A munkalapon közös keretben lévő cellák egyesítve vannak vagy külön cellák csak a keretük közös? (gyanítom külön cellák) Ha van köztük egyesített, melyek azok?
A különböző napokhoz tartozó űrlap részletek nyilván nem véletlenül különböznek. Van rá lehetőség, hogy egységes fejlécet kapjanak?
-
.OM.
aktív tag
-
lappy
őstag
válasz m.zmrzlina #23442 üzenetére
Minden naphoz más-más terem illetve időpont tartozhat.
A táblázatban nincs egyesített cella csak a képen nem jól látszik.Bámulatos hol tart már a tudomány!
-
Mittu88
senior tag
válasz m.zmrzlina #23433 üzenetére
Köszönöm szépen, Fferi-nek is
Viszont felmerült egy másik probléma:
Van egy ilyen kódom:
Public sor As Integer
...
Private Sub Worksheet_Change(ByVal Target As Range)
sor = Target.Row
...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim nev As String
...
nev = Cells(sor, 1).Value
...És erre azt a hibaüzenetet dobja, hogy Application-defined or object-defined error.
A sor változó értéke 0, tehát nyilván nem tudja a nev változónak egy nem létező cella értékét adni. De mitől 0 a sor értéke?
Próbáltam a sor = ActiveCell.Row parancsot is, de ugyanez van. -
Fferi50
őstag
válasz Mittu88 #23446 üzenetére
Szia!
Akkor produkálja ezt a hibát szerintem, ha a selection_change úgy következett be, hogy nem volt előtte egyik cellában sem változás (pl. egy celláról simán tab-bal ment tovább valaki, vagy csak belekattintott valahonnan).
Próbáld ezt a selection_change -nél, mielőtt a cells(sor,1) utasításra mennél:
if sor=0 then msgbox "Nem volt változás" :exit subTermészetesen a then után azt írsz be, amit szeretnél, hogy végrehajtódjon. Pl. adhatsz értéket a sor változónak.
Üdv.
-
Wyll
őstag
Üdv
Hogyan lehet makrobol elindítani egy másik (már megnyitott) file másik makróját?
A következőt szeretném:
a.xlsm fileban elindítom az x makrót. Futása soran ez megnyitja b.xlsm file-t. Ott csinál ezt-azt (aktív a b.xlsm workbook), majd meghívja b.xlsm file y makróját. Y szépen lefut, majd visszaadja a vezérlést x-nek.
Mellesleg ekkor x is befejeződik, es b.xlsm maradjon aktív.Szoval ezt hogyan kellene?
[ Szerkesztve ]
Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=Wyll
Új hozzászólás Aktív témák
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!
- Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- World of Warcraft Shadowlands Collectors edition EU EN
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office