-
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
-
eszgé100
őstag
válasz eszgé100 #44488 üzenetére
vetne erre valaki egy pillantást?
fenti problémát szeretném még mindig megoldani, a változókat szépen összelinkelem egy dokumentumból, valamint ugyanebben a dokumentumban elhelyezek egy Gombot, ami lefuttat valami hasonlót:
Sub Open_Word_Document()
Set objWord = CreateObject("Word.Application")
objWord.Documents.Open "Z:\Excel\ALBÉRLET.docm"
objWord.Visible = False
objWord.Application.Run "NewMacros.toprint"
CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))
objWord.Quit SaveChanges:=objWordsDoNotSaveChanges
Set objWord = Nothing
End Sub
A word doksiban pedig lefutnak ezek a makrók:
Sub kicsi()
'
' kicsi Macro
'
'
Selection.WholeStory
Selection.Font.Size = 10
End Sub
Sub toprint()
'
' toprint Macro
'
'
Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter
Application.Run MacroName:="kicsi"
Application.ActivePrinter = "HPFDDA3F (HP Photosmart C4500 series)"
Application.PrintOut Range:=wdPrintAllDocument, Copies:=1
Application.ActivePrinter = strCurrentPrinter
End Sub
Természetesen csak egy példa, ami nagyjából azt demonstrálja, hogy egy gombnyomásra a háttérben megnyíljon a Word/Excel, lefuttasson adott makrókat majd azt egy megadott nyomtatóra elküldje, és mentés nélkül zárja be.
Ezen kívül kell még szerintetek nekem valami, mielőtt nekiállok linkelni a doksikat és nagyüzemben makrókat írni hozzájuk?
"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."
-
Fferi50
őstag
válasz eszgé100 #44542 üzenetére
Szia!
Azért lenne pár kérdésem ez alapján.
Először a makrókhoz:
Dokumentumokról beszélsz, ezek Excel vagy Word fájlok?Sub Open_Word_Document()
Set objWord = CreateObject("Word.Application")
objWord.Documents.Open "Z:\Excel\ALBÉRLET.docm"
objWord.Visible = False
objWord.Application.Run "NewMacros.toprint"
CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))
objWord.Quit SaveChanges:=objWordsDoNotSaveChanges
Set objWord = Nothing
End Sub
Itt megnyitsz egy Word alkalmazást és abban egy dokumentumot, majd lefuttatsz egy makrót, ami a Word alkalmazásban (NewMacros) van, ami kinyomtatja azt. Ezután létrehozol egy Excel alkalmazást és bezárod a Word-ot.
Ha Excelből indítod a makrót, akkor miért kell új Excel alkalmazás létrehozni? Ha Wordben van a makró, akkor miért kell új Word alkalmazást létrehozni, majd bezárni?
Nem tudom hány xls-ed van, de nem hiszem, hogy mindegyiket külön-külön el kellene látni ugyanazon funkciókat végző makrókkal. Én egy alap Excelt használnék, amiben a makrók benne vannak és abból intézném az összes többinek a megnyitását és kezelését. Így csak egy fájlt kell karbantartani, nem pedig x db-ot.
De lehet, hogy rosszul látom.
Üdv.[ Szerkesztve ]
-
Fferi50
őstag
válasz eszgé100 #44552 üzenetére
Szia!
A CreateObject egy új Excel példány hoz létre, ami teljesen szükségtelen.
"így megsprórolom a fájlok külön megnyitogatását is, ugye?"
Ezt nem gondolnám, mert hogyan tudná akkor beállítani a megfelelő értékeket a nyomtatáshoz? Kívülről ez nem megy.
Viszont nem kell minden fájlba beírni a makrókat, elég a "főfájlba betenni", ott pedig a makróban a beállításokat igazíthatod az éppen nyomtatni kívánt dokumentumhoz pl. a neve alapján. Tehát ez az egy makró szépen megnyitogatja amit kell, beállítja amit kell és kinyomtatja ahogyan kell. Azt is meg lehet vizsgálni, hogy melyik területen nyitották meg és ahhoz igazítani a nyomtatandó/nyomtatható fájlok listáját.
Üdv. -
Delila_1
Topikgazda
válasz eszgé100 #44669 üzenetére
A 3 képlet fentről lefelé
=DARABTELI(A$3;$AM$2:$AM$3)>0
=HÉT.NAPJA(A$3;2)>5
=DARABTELI($AK$2:$AK$12;A$3)>0Angol nyelvű Excelnél a függvények angol megfelelőjét kell írnod, és pontosvessző helyett vesszőt adj.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz eszgé100 #44675 üzenetére
Szeretnék még egy piros pontot.
A 3 utolsó oszlopra
($AC$3:$AE$22)
adhatunk egy újabb formázást, ahol a karakter színe szürke.
A képlet:=HÓNAP(AC$3)>HÓNAP($A$3)
A rövid hónapoknál hasznos.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
válasz eszgé100 #45135 üzenetére
Elég macerás lenne és csak makróval lehetne megoldani, de nem nagy értelmét látom...
Használj inkább feltételes formázást ikonkészlettel vagy adatsávokkal, sokkal egyszerűbb.[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz eszgé100 #45147 üzenetére
Óóóó, bakker, ezt Én nagyon félreértettem. nagyon másra gondoltam...
Akkor ennyi az egész.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'itt adhatod meg, hogy mely tartományban lévő cellákon működjön a duplaklikk
'itt a példában az A1:A5 tartományt vizsgálja
If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
Select Case Target.Value
Case 0
ActiveCell.Value = 25
Case 25
ActiveCell.Value = 50
Case 50
ActiveCell.Value = 75
Case 75
ActiveCell.Value = 100
Case 100
ActiveCell.Value = 0
End Select
'ez a kis "trükk" oldja meg, hogy nem lép be a cellába szerkesztési üzemmódba
Cancel = True
End If
End Sub[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz eszgé100 #47660 üzenetére
A megoldást már más megírta, úgy hogy csak INNEN bemásolom a kódot.
Annyi módosítást hajtottam csak végre a kódban, hogy a 3 db privát funkció deklarációban beleírtam a PtrSafe tulajdonságot, mivel enélkül 64 bites rendszer alatt nem futna le a kód.Module1-be kerülő kód:
Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long
Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma character in ValueValue
Dim ColonPos As Long ' position of colon character in ValueValue
Dim M As Long ' string index
' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)
' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
On Error Resume Next
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
On Error GoTo 0
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
' test for error
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function
Sub Test()
Dim Printers() As String
Dim N As Long
Dim S As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = S & Printers(N) & vbNewLine
Next N
MsgBox S, vbOKOnly, "Printers"
End SubEredménye (most az Én gépemen futtatva)
Nyilván esetedben annyiban kell módosítani pluszban a kódot, hogy ne a képernyőre irogassa ki az összes nyomtatót, hanem a cikluson belül, megvizsgálod, hogy az aktuális printer neve tratalmazza-e az általad használt 2 printer nevének egyikét, ha igen, akkor "elévarázsololod" a \\ jelet és a megfelelő változódnak meg is van az értéke és kb. meg is vagy.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz eszgé100 #47702 üzenetére
Az elv, amit felvázoltál, az rendben van, csak korábban 2 telepített hálózati nyomtatóról volt szó, az meg nem látszódik a listában, pedig kellene (nálad biztosan nincs telepítve ez a 2 nyomtató)
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
-
Fferi50
őstag
válasz eszgé100 #47746 üzenetére
Szia!
Nézetem szerint az alábbi módon lehetne megoldani a problémát:
A1 cellában van a január 1.
B1 cellában van meghatározva az év első hétfője, ezzel a képlettel:=HA(HÉT.NAPJA(A1;2)>=5;A1+8-HÉT.NAPJA(A1+7;2);A1-HÉT.NAPJA(A1;2)+1)
Ezek után a megfelelő hétfő meghatározása szerintem már egyszerű, csak az első hétfőhöz hozzá kell adni a kívánt hét számát 7-tel szorozva.
Remélem ezzel tudtam segíteni.
Az ISOWEEKNUM függvény és a mai dátum csak illusztráció. Ha tudjuk hanyadik hétről van szó, akkor elég azzzal szorozni.
Üdv.[ Szerkesztve ]
-
Fferi50
őstag
válasz eszgé100 #47751 üzenetére
Szia!
Több lehetőség is van. A képen látható elrendezés esetén E2 képlete:=MAX(ROUNDUP(ISOWEEKNUM(D2)/4,0)*4,ISOWEEKNUM(D2))*7+C2
Másik ötletem:
Az év elején (vagy akár most) felrakod egy segéd táblázatba a negyedik hétfőket:
Ne kavarjunk bele, legyen I2=C2, majd I3 képlete =I2+28
Lehúzod, ameddig szükséges, majd az így létrejött képletes részt átalakítod értékké (másolás, irányított beillesztés értéket) - csak a biztonság kedvéért, nehogy megváltozzon valami miatt. Akár el is nevezheted a táblázatot.
Ezután az E2 képlete:=IFERROR(VLOOKUP(D2,$I$1:$I$29,1,0),INDEX($I$1:$I$29,MATCH(D2,$I$1:$I$29,1)+1))
Üdv.[ Szerkesztve ]
-
félisten
válasz eszgé100 #47751 üzenetére
C3
=HA(HÉT.NAPJA(B3)=2;B3;B3+(7-HÉT.NAPJA(B3;2)+1))
=IF(WEEKDAY(B3)=2,B3,B3+(7-WEEKDAY(B3,2)+1))
D3
=C3+28
E3
=ISO.HÉT.SZÁMA(HA(HÉT.NAPJA(B3)=2;B3+28;(B3+(7-HÉT.NAPJA(B3;2)+1))+28))
=ISOWEEKNUM(IF(WEEKDAY(B3)=2,B3+28,(B3+(7-WEEKDAY(B3,2)+1))+28))
Már, ha jól értettem a feladatot (ha nem, akkor is így marad)
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
eszgé100
őstag
válasz eszgé100 #47756 üzenetére
Peldaul, ezt a munkafuzetet majd csak december 6-a elott kell ujra megnyitni es kinyomtatni, tehat egeszen addig nekem dec 6 legyen a cellaban, viszont ha mar 7-en nyitom csak meg legkozelebb, akkor mar jovo ev januar 3-ra lesz szuksegem
"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."
-
Pakliman
tag
válasz eszgé100 #47878 üzenetére
Szia!
Egy ilyen kódot találtam.
Nem tudom, műxik-e, nem próbáltam
Van benne egyJobsDesc(lThisJob).pDocument
sor a For .. Next ciklusban, talán a nyomtatandó file neve.(A saját programomban rákérdezek, hogy sikerült-e nyomtatás és csak azután megyek tovább. Bár nálam a nyomtatott dokumentum megléte és minősége a lényeg.)
Találtam mégy egyet, ami talán egy kicsit egyszerűbb(en átalakítható a Számodra).
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz eszgé100 #47881 üzenetére
Gyorsíthatod a futást, ha nem állsz rá lépten-nyomon egyes cellákra. 5 ilyen feltételt láttam.
If CStr(dat) <> "" Then
Sheets(ssheet).Select
Range(dat).Select
ActiveCell.Formula = sDate
End If
helyett írd ezt
If CStr(dat) <> "" Then Sheets(ssheet).Range(dat).Formula = sDate
Programozó: 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 eszgé100 #47881 üzenetére
Szia!
Apróságokat tennék hozzá, talán gyorsít valamit rajta:
1. Kérdés: ahol Save&Close =no ott nem kell bezárni a fájlt? Mert ebben az esetben sok-sok fájlod nyitva fog maradni.
Ha mégis be kell zárni, akkorIf CStr(saveandclose) = "yes" Then
Excel.Workbooks(fileName).Close SaveChanges:=True
Else: GoTo nextraw
End If
helyett javaslom:Excel.Workbooks(fileName).Close SaveChanges:= CStr(saveandclose) = "yes"
Ha nyitva kell hagyni, akkor is elég az IF-es sor a következőképpen:If CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
Nem kell hozzá ELSE és END IF.
2. Javaslat: én nagyon nem szeretem az ugrálást makrón belül, általában mindig meg lehet oldani e nélkül a feladatot. Nálad 2 cimke van: openworksheets és nextraw.
Egy új változó bevezetésével el lehet kerülni a cimkéhez ugrást.
Dim nyomtatni As Boolean
Ennek a változónak adunk értéket a Select Case utasításokon belül - ezt is egy picit egyszerűsítve:Select Case CStr(freq)
Case "4 weekly", "monthly"
nyomtatni = True
Case "2 monthly"
nyomtatni = Month(nextmonth) Mod 2 = 1
Case "3 monthly"
nyomtatni = Month(nextmonth) Mod 3 = 1
End Select
A két cimke helyére pedig:openworksheets: helyett:
If nyomtatni Then
.
.
nextraw: helyett
End If
Áttekinthetőbb és szerintem gyorsabb is lehet.
3. Kérdés:
Milyen szűrést szeretnél? Hol lenne helye a hibakezelésnek?Üdv.
-
Fferi50
őstag
válasz eszgé100 #47915 üzenetére
Szia!
1.)"a ciklus későbbi lépéseiben még szükség lesz rájuk, pl amikor egy workbookban van 20 worksheet, de nem egyszerre ömlesztve akarom őket kinyomtatni,"
ugyanakkor a ciklusban minden sornál ott van a Workbooks.Open, anélkül, hogy megnéznéd, nincs-e már megnyitva az adott file.
"mert utána akkor még kézzel is le kell válogatnom később"
másrészt, ha egy következő file másik munkalapját nyomtatod utána, akkor nem kell kézzel leválogatni az előzőtől?
2.a) szerintem alapvetően akkor van szükség GoTo utasításra, ha a makró/folyamat rosszul van megtervezve, megszervezve. Az ugrálás rontja az áttekinthetőséget és szerintem lassítja is a végrehajtást. Egy esetben látom indokoltnak, a futási hibák kezelésénél, ott ahol a hiba természete miatt külön hibakezelési rutinra van szükség az adott makrón belül. (Lásd: On Error Goto .. utasítás ).
2.b) Mod funkció -> egy osztás maradék eredményét adja vissza. Nálad azért 1 a feltétel értéke, mert mindig az adott ciklus utáni első hónapban nyomtatod a munkafüzetet (vagy ha úgy jobban tetszik, a ciklus első hónapjában). 3 havonta esetén az 1,4,7,10 hónapban. De mondhatnád azt is, hogy a 3,6,9,12 hónapban akarod nyomtatni, akkor a 0 maradék lenne a feltétel. Tehát te döntöd el, melyik hónapban kezdődjön a nyomtatási ciklus és a maradékot annak megfelelően használod feltételnek. Ugyanez igaz a többi ciklikus feltételre is.
3.a) Hibakezelésen tehát a felhasználói hibák vizsgálatát érted (amivel egyrészt megelőzheted fals adatok dokumentálását, másrészt program futási hibák keletkezését). Azt gondolom, erre az esetre érdemes egy külön függvényt írni, ami megizsgálja a kritikus összefüggéseket és logikai értéket ad vissza a vizsgálat eredményéről, amitől függően megy tovább a ciklus vagy elengedi azt a munkafüzetet/lapot.
Érdemes ettől függően azon is gondolkodni, hogyan kezeljük a futás idejű hibákat, mivel nem szeretnénk, ha ezek miatt utólag kellene a felhasználókkal hibát javíttatni.
3.b) Szűrés esetén a Darabteli függvény nincs tekintettel a szűrt állapotra valóban. Ebben az esetben a Save&close cella tartalma helyett meg kell nézned a szűrt területet makróval.
A D oszlop szűrt tartományát a következőképpen kapod meg:ActiveSheet.UsedRange.Columns("D").SpecialCells (xlCellTypeVisible)
A Find metódussal meghatározhatod a keresett érték helyét.Dim scrange As Range
Majd a nyomtatás után:Set scrange=ActiveSheet.UsedRange.Columns("D").SpecialCells (xlCellTypeVisible).Find(what:=sPath,after:=Range("D" & counter))
If scrange.Row<=counter then --- save & close
Mivel nincs további találalat a szűrt tartományban, ezért az első találatra fog visszaugrani.
Üdv. -
Fferi50
őstag
válasz eszgé100 #47923 üzenetére
Szia!
Szerintem először nézd meg a Manual Update értékét.If Not manualcheck Then
Set scrange=ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
If scrange.Row <= counter Then Excel.Workbooks(fileName).Close SaveChanges:=True
End If
Sőt, tulajdonképpen a keresési eredményt közvetlenül is lehet használni:If ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter)).Row <= counter Then Excel.Workbooks(fileName).Close SaveChanges:=True
mivel legalább az adott sorban levő tételt meg fogja találni, tehát hibát nem okozhat a találat hiánya.
Üdv.[ Szerkesztve ]
-
Fferi50
őstag
válasz eszgé100 #47923 üzenetére
Ha jól látom, akkor a manualcheck változód a ciklus során nem változik, illetve a manual "Yes" esetén True lesz. Ez ugye szűrésnél rendben is van, de ha nincs szűrés, akkor egyetlen kézi ellenőrzésre szoruló tábla is megakasztja az összes többi bezárását is.
Ha jól gondolom, akkor a szűrés nélküli állapotban meg kellene vizsgálni, hogy az adott fájlhoz tartozik-e olyan sor, amelyben kézimunka szüksége.
Ezt a Countifs függvénnyel lehet megnézni szerintem, első feltétel a fájl neve a D oszlopon, második feltétel a yes a Manual Update oszlopon. Ha ez nem 0, akkor nem lehet a fájlt bezárni.
Üdv. -
eszgé100
őstag
válasz eszgé100 #47952 üzenetére
találtam egy szebb megoldást:
If manualcheck = True Then
For Each wb In Workbooks
Windows(wb.Name).Visible = True
Next
ma.Activate
Range("A1").Select
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End If"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."
-
Paxker315
addikt
válasz eszgé100 #48036 üzenetére
eszgé100 kérdése nem tudom meg lett-e már válaszolva, pedig engem is érdekelne. Esetleg valaki?
[ Szerkesztve ]
https://dynotech.hu/ - Új, kultúrált környezet, könnyen megközelíthető : )
-
Fferi50
őstag
válasz eszgé100 #48082 üzenetére
Szia!
Szerintem majdnem minden tanfolyamra elmondhatja valaki, hogy semmit sem ért....
Ha nem érintette azokat a témákat, ami őt érdekli, esetleg sok olyan dolog volt benne, ami neki már a kisujjában van stb.
Ezért azt javaslom, célratörően, a téged legjobban érdeklő témákban (függvényekben) nézz körül először az Excel Helpjében, aztán vagy azzal párhuzamosan a neten. Rengeteg példát, ismertetőt fogsz találni.
Olyan nincs, hogy részt veszel 1 db tanfolyamon és a kezedben lesz az Excel bölcsek köve.
Eredeti felvetésedhez kiegészítésként még annyit, hogy fontos a probléma megfogalmazása, ezután a kapcsolódó "modell" megalkotása majd ezután jöhet az Excel szerintem. Kérdés, mit szeretnél a befektetéseidről látni a táblázatban...
Üdv.[ Szerkesztve ]
-
félisten
válasz eszgé100 #48468 üzenetére
1. Az mindegy, hogy hol található (helyi/hálózati) a fájl, a 70-es kód ugyanaz, hozzáférés megtagadva (Permission denied)
2. Kérdésedben ott a válasz is, mert olvasásra kell megnyitni a fájlt, csak Te nem úgy nyitottad meg. A Workbooks.Open method (Excel)
A 3. paramétert kell igazra állítani, és akkor read-only-ban próbálja megnyitni, plWorkbooks.Open "c:\ubul\ubul.xlsx", , True
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
lappy
őstag
válasz eszgé100 #50065 üzenetére
Sub TwoFonts2()
Dim MyPos, SearchChar
SearchChar = "."
Range("B2").Select
With ActiveCell.Characters(Start:=5, Length:=1).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=8, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub[ Szerkesztve ]
Bámulatos hol tart már a tudomány!
-
eszgé100
őstag
válasz eszgé100 #50096 üzenetére
megtalaltam mi a hiba, viszont igy egy masik kerdes merult fel.
F, G, H oszlopban felteteles formazas van ervenyben, 0 eseten a betu es hatter szine feher, ami jo is addig amig a Customert es a Commodity-t ki nem valasztom egy legordulo listabol. Ekkorra az index formulak eredmenye mar nem 0, szoval a felteteles formazasnak el kellene tunnie, de a feher betuszin nem valtozik meg valamiert, tudtok erre valami magyarazatot?"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."
-
Fferi50
őstag
válasz eszgé100 #50137 üzenetére
Szia!
Úgy tűnik, hogy a SaveCopyAs nem szereti, ha a fájlt a hálózatra szeretnénk felmásolni. Valószínűleg egy jó kis bug. Jelezni kellene Redmond felé.
Megkerülő megoldás:
Megjegyzed a fájl nevét és elérési útját egy változóban.
Ezután SaveAs a fájlt a hálózatra, majd ismét SaveAs a változóban eltárolt paraméterekkel. Így visszajutsz az eredeti fájlodhoz. Szomorú, tudom, de legalább működik.
Üdv. -
eszgé100
őstag
válasz eszgé100 #50198 üzenetére
Sziasztok!
Korábbi kérdésemből csak az "adott pötty fölé viszem az egeret, akkor megjelenítse a szériaszámot" maradt aktuális
Megoldható, hogy a Point "18/01/2023" helyett egy másik cella értéke legyen megjelenítve, pl C1-ben -37 van, viszont kellene a hozzá tartozó B1?
Másik újabb kérdésem a scatter plot charttal kapcsolatban, hogy meg lehet oldani, hogy a x tengely Dátum az adott tárgyhó 1-től induljon és tárgyhó végével érjen véget? Automatikusan Excel kiterjeszti a tengelyt mindkét irányba, hiába nincs semmilyen adat y-tengelyen megjelenítve. Kézzel meg tudom oldani, de ezt minden hónapban el kellene játszni, jobb lenne automatikus megoldás.
"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."
-
Fferi50
őstag
válasz eszgé100 #50380 üzenetére
Szia!
Pontosan milyen feltételeknek kell megegyezniük ahhoz, hogy TRUE legyen az eredmény?
Miért van az, hogy a második képen a MODEL1SUB2_2_3 első sorában FALSE van, a második előforduláskor pedig TRUE?
A második táblázat hogyan keletkezik?
Mivel az első táblában "hiányos" az információ - csak annyit tudunk, hogy mennyi a Batch Size, azaz hány sornak kellene minimum lennie a második táblában, ezért szerintem makró kell majd hozzá.
De pontosan kellene ismerni a feltételeket, mit mivel kell hasonlítani - ahogyan az első kérdésemben írtam.
Üdv. -
Delila_1
Topikgazda
válasz eszgé100 #50615 üzenetére
Az E oszlopodra:
Sub Zold_Piros()
Dim sor As Long, usor As Long, kezd As Integer, hossz As Integer
usor = Range("E" & Rows.Count).End(xlUp).Row
For sor = 1 To usor
If Right(Cells(sor, "E"), 4) = "true" Then
hossz = 4
kezd = InStr(Cells(sor, "E"), "true")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 4
Else
hossz = 5
kezd = InStr(Cells(sor, "E"), "false")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 3
End If
Next
End SubLusta voltam a nagybetűre váltást bele venni, majd kiigazítod.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz eszgé100 #50643 üzenetére
Az újra színezés előtt vissza kell állítani egységes színűre a cella karaktereit.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column = 5 Then
Application.EnableEvents = False
Cells(Target.Row, 5).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, 5))
If Mid(Cells(Target.Row, 5), b, 4) = "True" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, 5), b, 5) = "False" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz eszgé100 #50665 üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column >= 5 And Target.Column <= 8 And Target.Row = 25 Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, Target.Column))
If Mid(Cells(Target.Row, Target.Column), b, 4) = "True" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, Target.Column), b, 5) = "False" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mutt
aktív tag
válasz eszgé100 #50731 üzenetére
Szia,
Power Tools-ban (BI/Query/Pivot) nincs alapból REGEX, így ezt a macerás képletet tudom ajánlani.
IS_ACCURATE =
var helyes_hossz = 20
var hossz = len([Minta]) = helyes_hossz //megfelelő a hossz?
var csoport1 = Not(ISERROR(VALUE(LEFT([Minta]; 3)))) //első 3 karakter szám?
var csoport2 = Not(ISERROR(SEARCH(MID([Minta];4;1);"ABCDEFGHIJKLMNOPQRSTUVWXYZ";1))) //4 karakter nagybetű?
var csoport3 = Not(ISERROR(VALUE(MID([Minta];5;8)))) //5-12 karakterek számok?
var csoport4 = Not(ISERROR(SEARCH(UPPER(MID([Minta];13;1));"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";1))) //13 karakter helyes?
var csoport5 = Not(ISERROR(VALUE(MID([Minta];14;7)))) //14-20 karakterek számok?
var eredmeny = hossz * csoport1 * csoport2 * csoport3 * csoport4 * csoport5
return if(eredmeny;1;blank())[Minta] helyére írd be a nálad használt tábla+mezőnevet. A végén üres értéket adok vissza hibásakra, mert akkor egyből elrejti a Power BI a helytelen értékeket, de ha látni akarod és szűrni, akkor "return eredmeny" a vége.
üdv
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Mutt
aktív tag
válasz eszgé100 #50736 üzenetére
Szia,
DAX-ban van olyan hogy implicit és explicit measure. Mindegyiknek van előnye és hátránya, implicit könnyebben átlátható, de lassabb, az explicit gyorsabb de nehezebb is.
Amikor segédoszlopokról beszélsz, akkor az implicitet jelent. Explicit esetén nincs segédoszlop, hanem a képlet számolja real-time az eredményt azon adatok alapján amit a szűrők átadnak neki (itt fontos megemlítenem a row-context és filter-context koncepciót).
Tudsz nested IF-et használni és ha tudod egy képletben összerakhatod az összes ellenőrzést.
Nem javasolnám a 20+ oszlop létrehozását csak emiatt, de mivel még ismerkedsz vele szerintem nem gond ezen az úton elindulni. Azonban nem tudom elképzelni hogyan tudsz majd ilyen esetben szűrni, hiszen néha egyik, néha másik oszlop alapján kell majd neked eredmény.Power BI-ban lehet Python szkripteket futtatni, ahol már van regex, így ha túl bonyolult lenne DAX-al megoldani akkor ezen is lehet elindulni.
üdv
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
Új hozzászólás Aktív témák
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- AKCIÓ! - STEAM kulcsok /Anuchard, Aragami, Children of Morta, stb. - 2024.04.17.
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- BIG BOX lot - Adventure II. (Stonekeep, Myst 3, UO 2nd Age)
- World of Warcraft : The War Within eladó
- Windows 7 Home Premium, Pro, Ultimate és Windows 8, 8.1 Pro licenckulcsok 64, 32 bit - MEGA Akció!
- Windows Server 2016, 2019, 2022 Standard, Datacenter, Essentials termékkulcsok - MEGA akció!
- Microsoft 10/11/Pro/Home/Office szoftver
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Promenade Publishing House Kft.
Város: Budapest