- Nem fogy a Galaxy S25 Edge?
- iPhone topik
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Samsung Galaxy S24+ - a személyi asszisztens
- Google Pixel topik
- A Galaxy Z Fold7, minden színben és oldalról
- Samsung Galaxy A54 - türelemjáték
- Google Pixel 8 Pro - mestersége(s) az intelligencia
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Szerkesztett és makrofotók mobillal
-
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
-
ny.erno
tag
válasz
Fferi50
#48095
üzenetére
Szia!
Köszi. Igen, erre gondoltam a #48093-hszben. Viszont menet közbe rájöttem, hogy ha a Notepad++-ba nem copy-past-tal másolom be, hanem ctrl-o-val megnyitom a csv fájlt, akkor tökéletesen nyitja meg és onnan vissza másolva az eredeti csv-be, szintén tökéletesen jelenik meg.
Szóval működik, csak lett +1 lépés a folyamatba.
Köszi!
-
BEndre34
tag
válasz
Fferi50
#48075
üzenetére
Köszönöm, elsőre jó lett
Persze csak azután, hogy rájöttem, az egyszerűsített, ide készült minta tábla kép mindössze 2 oszlopból állt az eredeti 4 helyett (a képlet, amit bemásoltam, abból volt), így az elős percben nem értettem, a Tiéd miért nem jó.
De leesett a tantusz és úgy más minden 
volt. -
eszgé100
őstag
válasz
Fferi50
#47925
üzenetére
A fájl szűrés nélküli állapotban nyílik meg, és a manual update értéke ''no".
Ha kézzel átállítom "yes"-re függetlenül attól, hogy szűrtem-e, akkor alábbi kóddal tudtam megoldani, de nem vagyok benne biztos, hogy jól csináltam.Set scrange = ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
cntifres = WorksheetFunction.CountIfs(ws.Range("D2 : D" & lastrow), scrange, ws.Range("P2 : P" & lastrow), "yes")
If cntifres = 0 Then
If scrange.Row <= counter Then
Excel.Workbooks(fileName).Close SaveChanges:=True
ElseIf manualcheck = False & CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
End If
End IfAlapból a fájlokat nem látható ablakban nyitom meg, ezért még kellett a makró végére ez is, hogy megjelenjenek:
If manualcheck = True Then
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
If Not ws.Range("A" & counter).EntireRow.Hidden Then
sPath = ws.Range("D" & counter)
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
manual = ws.Range("P" & counter)
If CStr(manual) = "yes" Then Windows(fileName).Visible = True
End If
counter = counter + 1
Loop
ma.Activate
Range("A1").Select
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End IfRánézésre jól csináltam mindent?
-
hódmaci
senior tag
-
eszgé100
őstag
válasz
Fferi50
#47916
üzenetére
1a.) megnyitott fájlok ellenőrzésének gondolata már piszkálta nekem is a fantáziám, de bevallom, lusta disznó voltam foglalkozni vele, pedig egy nem túl bonyolult IsFileOpen funkciót használva 9 másodperccel lett gyorsabb.
1b.) valószínűleg a későbbiekben sorszámozva leszek a sheetek, hogy a fizikai lokáció szerinti sorrendben legyenek kinyomtatva, így egy helyszínre csak egyszer kell ellátogatni anélkül, hogy időt pocsékolnék a papírok válogatásával, de ezt még nem találtam ki pontosan, hogy hogy legyen.
3a.) még tesztelnem és gugliznom kell, hogy tovább kommenteljem
3b.) Save & Close most ilyen lett:'time to save&close
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
ElseIf manualcheck = False & CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
End Ifamivel annyi problémám van, hogyha így állítom be az értékeket, akkor bezáródik, hiába volt "yes" valamelyik cella a Manual Update oszlopban
ha a manualcheck-et is beteszem az első feltételbe, akkor run time error-t kapok
-
Delila_1
veterán
válasz
Fferi50
#47918
üzenetére
Ez csak azt mutatja, hogy tabulálással jól lehet láttatni az összetartozó egységeket. Hibakezeléssel:
If Range("A1") > 0 ThenGo To HibaElseRange("B1") = 20: Exit SubEnd IfHiba:MsgBox "..."On Error GoTo 0Egy rossz példa találomra erről a fórumról:Select Case CStr(freq)Case "4 weekly", "monthly"nyomtatni = TrueCase "2 monthly"nyomtatni = Month(nextmonth) Mod 2 = 1Case "3 monthly"nyomtatni = Month(nextmonth) Mod 3 = 1End Select -
Delila_1
veterán
válasz
Fferi50
#47916
üzenetére
Szerintem semmi gond a Go To utasítással. Az áttekinthetőséget a tabulátorok adják. Az ugrás címe mindig a 0 pozícióban van, az összes többi ettől jobbra.
Nagy időt a feltételek vizsgálata igényel ismereteim szerint.Az összetartozó részek is szépen látszanak egy normális tagolásnál.
If Range("A1") > 0 ThenRange("B1") = 10ElseRange("B1") = 20End If -
eszgé100
őstag
válasz
Fferi50
#47894
üzenetére
1.) pontosan, ott nem kell bezárni a fájlt, mert még 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, mert utána akkor még kézzel is le kell válogatnom később, amit nem szeretnék. A Save&Close oszlop celláinak értéke az =IF(COUNTIF(D2:INDIRECT("D" & COUNTIF(D
,"<>")),D2)>1,"no","yes") függvénnyel van meghatározva, ami eddigi tesztjeim alapján dinamikusan változik, amikor ugyanaz az elérési útvonal kerül a Path oszlop celláiba. Amennyiben az adott elérési útvonal nem ismétlődik többet a maradék cellatartományban az érték Save&Close "yes"-re változik és a workbook ment és bezárul2a.) mi pontosan a hátránya, hogyha GoTo-val ugrálok?
2b.) Másik ezzel kapcsolatban, hogy a Mod funkció működését nem teljesen értem, legalábbis az én esetemben. Pl ha "6 monthly"-t keresem, akkor azokat a hónapokat keresem, amelyeket 6-al oszthatóak maradék 1-el? Ez január és július esetében (1/6= 0 maradék 1) és (7/6=1 maradék 1), "yearly" pedig (1/12=0 maradék 1)?
2c.) címkéket megszűntettem if - end if-eket használva3.) hibakezelés, pl valami létfontosságú cella nincs kitöltve. Szűrést pedig úgy értem, hogy kézzel leszűröm az adatokat, majd arra eresztem rá a makrót, hiba a Save&Close-nál van, mert olyankor is a maradék tartományt figyeli, mikor az egyébként a szűrés miatt nem látszik.
+ A kódhoz hozzáadtam egy response-t, ami a user arcába tolja, hogy a makró milyen nyomtatókat fog használni, mindkettőt le kell okézni, csak így kerül az ellenörző cellába, ahonnan a makró majd használja. Ha valamelyik cella üres, akkor a kód megáll, és informálja a usert. Ezen kívül még hozzáadtam egy manual update oszlopot is az adattáblán, alapból ki van kapcsolva, de ha "yes" az értéke, akkor csak megnyitja a workbookot, majd megy tovább a ciklus, valamint egy néhány sort, hogy szűrést és manual update-et alaphelyzetbe állítsa miután a fájl megnyílik.
így néznek ki:
Sub Auto_Open()
Dim start As Date
Dim weekcom As Date
Dim today As Date
Dim response As VbMsgBoxResult
Dim lo As ListObject
Dim ws As Worksheet, ma As Worksheet
Dim lastrow As Long
Set lo = Worksheets("OpenClose").ListObjects(1)
lo.AutoFilter.ShowAllData
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
'ma.Unprotect "123"
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("P2:P" & lastrow) = "no"
Worksheets("MainAssembly").Activate
Range("A1").Select
start = Sheets("MainAssembly").Range("F3").Value
today = Sheets("MainAssembly").Range("F7").Value
weekcom = start
Do While weekcom < today
weekcom = weekcom + 28
Loop
Sheets("MainAssembly").Range("F6").Value = weekcom
Dim Printers() As String
Dim N As Long
Dim S As String
Dim col As String
Dim bw As String
Printers = GetPrinterFullNames()
Sheets("MainAssembly").Range("F8:F9").Value = ""
For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then col = S
If InStr(S, "HP Photosmart Wireless B109n-z") <> 0 And InStr(S, "Print") = 0 Then bw = S
Next N
response = MsgBox(col, vbOKCancel, "Confirm the Colour Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F8").Value = col
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If
response = MsgBox(bw, vbOKCancel, "Confirm the B&W Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F9").Value = bw
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If
'ma.Protect "123"
End SubSub EOM_Main_Assy_Workbooks()
'loop:
Dim sPath As String, ssheet As String, fileName As String
Dim lastrow As Long, counter As Long
Dim ws As Worksheet, tp As Worksheet, ma As Worksheet
'print:
Dim bw As String, col As String
Dim toprint As Boolean
'from main worksheet:
Dim sDate As String
Dim sWeek As String
Dim sWkcom As String
Dim nextmonth As Date
'from Table:
Dim freq As String
Dim area As String
Dim loc As String
Dim dat As String
Dim week As String
Dim wkcom As String
Dim procloc As String
Dim procname As String
Dim machloc As String
Dim machname As String
Dim printer As String
Dim copies As Integer
Dim saveandclose As String
Dim manual As String
Dim manualcheck As Boolean
sDate = "=[FillerPrinter.xlsm]MainAssembly!$F$4"
sWeek = "=[FillerPrinter.xlsm]MainAssembly!$F$5"
sWkcom = "=[FillerPrinter.xlsm]MainAssembly!$F$6"
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
nextmonth = ma.Range("F4")
col = ma.Range("F9")
bw = ma.Range("F9")
'1st condition
If ma.Range("F8") = "" Or ma.Range("F9") = "" Then
MsgBox prompt:="One or both printers are not selected." & VBA.Constants.vbNewLine & "Please click on Update / Reset button!" & VBA.Constants.vbNewLine & "If not sure, please S-C-W!"
Exit Sub
End If
'End of 1st condition
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
manualcheck = False
Do While counter <= lastrow
'2nd condition
If Not ws.Range("A" & counter).EntireRow.Hidden Then
freq = ws.Range("A" & counter)
area = ws.Range("B" & counter)
loc = ws.Range("C" & counter)
sPath = ws.Range("D" & counter)
ssheet = ws.Range("E" & counter)
dat = ws.Range("F" & counter)
week = ws.Range("G" & counter)
wkcom = ws.Range("H" & counter)
procloc = ws.Range("I" & counter)
procname = ws.Range("J" & counter)
machloc = ws.Range("K" & counter)
machname = ws.Range("L" & counter)
printer = ws.Range("M" & counter)
copies = ws.Range("N" & counter)
saveandclose = ws.Range("O" & counter)
manual = ws.Range("P" & counter)
'freq check
Select Case CStr(freq)
Case "4 weekly", "monthly"
toprint = True
Case "2 monthly"
toprint = Month(nextmonth) Mod 2 = 1
Case "3 monthly"
toprint = Month(nextmonth) Mod 3 = 1
Case "6 monthly"
toprint = Month(nextmonth) Mod 6 = 1
Case "yearly"
toprint = Month(nextmonth) Mod 12 = 1
End Select
'open sheets
'3rd condition
If toprint Then
Application.ScreenUpdating = True
ma.Visible = True
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
Application.StatusBar = "Processing File: " & fileName
Application.ScreenUpdating = False
Workbooks.Open sPath
Windows(fileName).Visible = False
'4th condition
If CStr(manual) = "no" Then
'update sheets if necessary
If CStr(dat) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(dat).Formula = sDate
If CStr(week) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(week).Formula = sWeek
If CStr(wkcom) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(wkcom).Formula = sWkcom
If CStr(procloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(procloc).Formula = procname
If CStr(machloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(machloc).Formula = machname
'print sheets
Set tp = Workbooks(fileName).Worksheets(CStr(ssheet))
Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End Select
'wait here a bit
Do While ActiveWindow.View = xlPrint
Loop
'time to save&close
If CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
Else:
'Windows(fileName).Visible = True
manualcheck = True
'End of 4th condition
End If
'End of 3rd condition
End If
'End of 2nd condition
End If
counter = counter + 1
Loop
Application.StatusBar = "Done!"
Application.ScreenUpdating = True
ma.Activate
Range("A1").Select
If manualcheck = True Then
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End If
End Sub -
#47908
Fire/SOUL/CD
félisten
Fferi50
#47907
-
#47905
Fire/SOUL/CD
félisten
Fferi50
#47903
válasz
Fferi50
#47903
üzenetére
Amit itt a képeden bemutatsz, azt raktam ki én is képben (Public deklaráció (meg még mást is))... Persze, hogy úgy már lehet vele dolgozni bárhonnan
"Téves az az információd, hogy a modul elején publikusnak definiált változót csak az a modul tudja használni, amelyben definiálták. Mivel publikus,... "
Ööö a MyGlobalVariable_2 az Private deklaráció(tehát NEM Publikus, szvsz ezen átsiklottál
), ergó sem más modulból, sem woorksheet kódból nem lehet elérni, csak abból a modulból, ahol deklarálva van (Én erről írtam, azt, amit, nem a publikus változóról)... 
Modulnév.változónév formában sem (szerkesztő el fogja fogadni, engedi beírni, nem nyaffog miatta, de ha futtatni próbálod a makrót, akkor jön a hiba -
eszgé100
őstag
válasz
Fferi50
#44543
üzenetére
"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."Üdv Fferi50,
Nem láttad rosszul a dolgokat, jelenleg így állok a dologgal:
Ez a kód lefut megnyitáskor:
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 Auto_Open()
Dim start As Date
Dim weekcom As Date
Dim today As Date
start = Sheets("MainAssembly").Range("F3").Value
today = Sheets("MainAssembly").Range("F7").Value
weekcom = start
Do While weekcom < today
weekcom = weekcom + 28
Loop
Sheets("MainAssembly").Range("F6").Value = weekcom
Dim Printers() As String
Dim N As Long
Dim S As String
Dim col As String
Dim bw As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then col = S
If InStr(S, "HP Photosmart Wireless B109n-z") <> 0 And InStr(S, "Print") = 0 Then bw = S
Next N
Sheets("MainAssembly").Range("F8").Value = col
Sheets("MainAssembly").Range("F9").Value = bw
MsgBox col, vbOKOnly, "Colour Printer"
MsgBox bw, vbOKOnly, "BW Printer"
End SubEz pedig elvégzi a piszkos munkát:
Sub EOM_Main_Assy_Workbooks()
'loop:
Dim sPath As String, ssheet As String, fileName As String
Dim lastrow As Long, counter As Long
Dim ws As Worksheet, tp As Worksheet, ma As Worksheet
'printers:
Dim bw As String, col As String
'from main worksheet:
Dim sDate As String
Dim sWeek As String
Dim sWkcom As String
Dim nextmonth As Date
'from Table:
Dim freq As String
Dim area As String
Dim loc As String
Dim dat As String
Dim week As String
Dim wkcom As String
Dim procloc As String
Dim procname As String
Dim machloc As String
Dim machname As String
Dim printer As String
Dim copies As Integer
Dim saveandclose As String
sDate = "=[FillerPrinter.xlsm]MainAssembly!$F$4"
sWeek = "=[FillerPrinter.xlsm]MainAssembly!$F$5"
sWkcom = "=[FillerPrinter.xlsm]MainAssembly!$F$6"
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
nextmonth = ma.Range("F4")
col = ma.Range("F9")
bw = ma.Range("F9")
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
ws.Activate
freq = Range("A" & counter)
area = Range("B" & counter)
loc = Range("C" & counter)
sPath = Range("D" & counter)
ssheet = Range("E" & counter)
dat = Range("F" & counter)
week = Range("G" & counter)
wkcom = Range("H" & counter)
procloc = Range("I" & counter)
procname = Range("J" & counter)
machloc = Range("K" & counter)
machname = Range("L" & counter)
printer = Range("M" & counter)
copies = Range("N" & counter)
saveandclose = Range("O" & counter)
'freq check
Select Case CStr(freq)
Case "4 weekly"
GoTo openworksheets
Case "monthly"
GoTo openworksheets
Case "2 monthly"
Select Case Month(nextmonth)
Case 1, 3, 5, 7, 9, 11
GoTo openworksheets
Case Else
GoTo nextraw
End Select
Case "3 monthly"
Select Case Month(nextmonth)
Case 1, 4, 7, 10
GoTo openworksheets
Case Else
GoTo nextraw
End Select
Case Else
GoTo nextraw
End Select
'open sheets
openworksheets:
Workbooks.Open sPath
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
'update sheets if necessary
Set tp = Workbooks(fileName).Worksheets(CStr(ssheet))
If CStr(dat) <> "" Then
Sheets(ssheet).Select
Range(dat).Select
ActiveCell.Formula = sDate
End If
If CStr(week) <> "" Then
Sheets(ssheet).Select
Range(week).Select
ActiveCell.Formula = sWeek
End If
If CStr(wkcom) <> "" Then
Sheets(ssheet).Select
Range(wkcom).Select
ActiveCell.Formula = sWkcom
End If
If CStr(procloc) <> "" Then
Sheets(ssheet).Select
Range(procloc).Select
ActiveCell.Formula = procname
End If
If CStr(machloc) <> "" Then
Sheets(ssheet).Select
Range(machloc).Select
ActiveCell.Formula = machname
End If
'print sheets
Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End Select
'wait here a bit
Do While ActiveWindow.View = xlPrint
Loop
'time to save&close
If CStr(saveandclose) = "yes" Then
Excel.Workbooks(fileName).Close SaveChanges:=True
Else: GoTo nextraw
End If
nextraw:
counter = counter + 1
Loop
Worksheets("MainAssembly").Select
Range("A1").Select
MsgBox "Done!"
End SubEz nem az összes workbook, amivel foglalkoznom kell, de egyelőre tesztnek elegendőek ezek is. Jelenlegi formájában a kód 88 sheetet kevesebb, mint 2 perc alatt megnyitott, update-elt, nyomtatóra küldött, majd bezárt
Már csak szűrést és hibakezelést kellene beleszőnöm valahogy.
Az egész csoportnak köszönöm mégegyszer az eddigi segítséget -
ny.erno
tag
válasz
Fferi50
#47870
üzenetére
Szia!
A folyamat lassabb lett, valamint ha hozzáadtam az A oszlopba folytatólagosan sorozatszámokat, akkor a második munkalapon alul ahol összesíti a darabszámot, az összegnél az tűnt fel, hogy az eredetileg a táblában szereplő összeg van. Próbáltam mindkét lapon frissíteni az adatokat és úgy lefuttatni, de ugyan az volt az eredmény. -
ny.erno
tag
válasz
Fferi50
#47864
üzenetére
Szia!
Profi, MŰKÖDIK!!!
Tesztelgetem különböző listákkal, de szerintem rendben lesz. Nálam új értékekek hozzáadása után, futtatás előtt ki kell törölnöm a másik munkalapot, plusz az első munkalapon a kilistázott egyedi és ismétlődő értékeket. De ez a három kattintás semmiség, szóval mégegyszer köszönöm! 
-
ny.erno
tag
válasz
Fferi50
#47859
üzenetére
Szia!
Megnéztem, az egyedi értékeket 980 egyedi értékig gyűjti ki (~135k helyett), de késznek tekinti, nincs hibakód.
Egyébként plusz érdekesség, hogy a NotePad++-szal megszűrt listát (kódolás UTF-8) másolok be excelbe és azon a listán futtatom a makrót, akkor az alábbi hibát dobja befejezés előtt: Run-time error '13': Type mismatch
Ha ugyan ezt a Notapad++ listát jegyzettömbe másolom és onnan excelbe, akkor megint másik hibakód jön: Run-TIme Error '1004': Method 'StatusBar' of object '_Application' failed.
Ide tettem a fájlokat, amin próbálgatom a lehetőségeket.
Eredeti excel makró eredmény: 135.531 egyedi érték
NotePad++ eredmény: 135.521 egyedi érték
Scrapebox eredmény: 135.020 egyedi érték -
-
ny.erno
tag
válasz
Fferi50
#47842
üzenetére
Valóban lemaradt. Simán feltételes formázással, utána pedig cella rendezés szín szerint.
A második képleted próbálom éppen. 139e sorral tesztelek és megint fagyás közeli állapot van.
Jobb alsó sarok üzenete: "Számítás folvamatban (4 szál): 10% (4-5 perc). Az első képlet hasonlóan lassú ekkora adattáblánál. Minden feltételes formázási szabály ki van kapcsolva. -
bsh
addikt
válasz
Fferi50
#47822
üzenetére
@Kasya: 64bit. a fájlok nem nagyok (mármint az excel táblák).
@FFeri50: speciális darabjegyzéket generál cad-ből. egyedüli képletek amik vannak, ha egy tételhez tartozik pdf rajz, akkor a sima szöveges tételszám mezőbe belinkeli azt =HYPERLINK()-kel, de semmi több. minden más cella sima szöveg/szám. kis színezés, kommentek, ilyesmi. a képletszámítást, eventeket és a screenupdating-et kikapcsolja a makró futás alatt és az excel tábla rejtve van amíg el nem készül.
-
Slowman
aktív tag
válasz
Fferi50
#47813
üzenetére
Szia,
Lehet nem jól fogalmaztam . Nagyobb mennyiségű adatot tartalmazó állományból kell kiszedni az alább említett feltételekből a mai és holnapi szállításokat egy dasboardszerű fülre (managementnek one pager), hogy ne kelljen bogarászni/szűrni a komlett listát.
Készítettem egy On Pager munkalapot több más paraméterrel. A forrásfileokat az érintett részlegek csak bemásolják abban a formában ahogy ők azt kezelik a megfelelő munkalapra, a One Pageren pedig a kért feltételeknek/formátumnak megfelelően megjeleníti az információt. Így sajnos szűréssel nem megoldható... -
eszgé100
őstag
válasz
Fferi50
#47752
üzenetére
köszönöm szépen, az első megoldás a befutó egyelőre, viszont még gondolkozok fire/SOUL/CD formuláin is.
fire/SOUL/CD: köszönöm neked is, adtál egy extra ötletet, a "nem hétfő van éppen" kiegészítéssel. A feladat, hogy egy, a korábbi hsz-emben található munkalap variációi minden 4. hétfő reggelre ki legyenek nyomtatva, a megfelelő dátumokkal és hét számozással. Ez a valóságban leggyakrabban úgy néz ki, hogy valamelyik korábbi hét folyamán ki vannak nyomtatva (ez általában a közvetlen korábbi hét, de lehet, hogy 2 vagy akár 3 héttel korábbi is) és aztán a péntek éjjeles mikor teljesen kitöltötte az összes mezőt az aktuális lapon, bekészít egy új lapot hogy a hétfő reggeles már tudja használni, a régit pedig archiválja. A nem hétfő van éppen kifejezés akkor jönne jól, ha valami oknál fogva csak hétfő kora reggel lennének kinyomtatva, és az már a nagyon sürgős pillanat, mert addigra már mindenkinek kell egy friss.
Tehát a cella értéke, amit keresek, ha pl 01/01/2022-től indulok, akkor az év első hétfője, majd az azt követő minden 4. hétfő. Ha a dátum már túlment rajta, akkor a cella frissüljön a következő 4. hétfő dátumára.
-
eszgé100
őstag
válasz
Fferi50
#47747
üzenetére
köszönöm, eddig jutottam a dologgal:
A következő 4. hétfőt egy egyszerű makróval számoltam ki:Sub weekcomupdate()
Dim start As Date
Dim weekcom As Date
Dim today As Date
start = Range("C2").Value
today = Range("D2").Value
weekcom = start + 28
Do While weekcom < today
weekcom = weekcom + 28
Loop
Range("E2").Value = weekcom
End SubA hét számát pedig isoweeknum-mal. Meg lehetne oldani, hogy a makró tartalmát formulává tudjam konvertálni és beilleszteni az E2-es cellába?
-
#47730
Dark Archon
addikt
Fferi50
#47726
-
#47680
Dark Archon
addikt
Fferi50
#47676
-
botond187
csendes tag
válasz
Fferi50
#47591
üzenetére
Szia,
Kipróbáltam, valamiért nem működött, valószínűleg én voltam a béna.
Feltöltök egy mintafájlt, úgy valószínűleg egyszerűbb lesz, illetve kicsit módosítanék is az eredmény kiszámításán:2 féle számolási módot képzeltem el, viszont mindkettő más-más megközelítést, számolást követel meg, ezért csak az egyiket írom le:
Erre a fülre igazából nincs szükség ebben a számolási formában, így csak információként van jelen:(Szóval úgy képzeltem el, hogy adott az excel "Raktárkészlet" fülén a "C" oszloptól kezdődően, hogy milyen készletmozgások voltak az adott napon.1 oszlop 1 nap.Ebben benne van az eladás és a beérkezett termékmennyiség is.)Adott a "Beszerzések" fül, ahol látni, hogy milyen dátummal melyik azonosítójú termékből mennyi érkezett és milyen áron.
Adott még az "Eladások" fül, ahol látni, hogy 1 termékből melyik napon mennyi ment el.
Itt a "KISZÁMLÁZÁS DÁTUMA" oszlopát nézze, hogy mikor lett kiszámlázva az adott termék, és vesse össze, hogy legalább aznap vagy azt megelőzően milyen áron érkezett a rendelésben lévő adott termék (magyarul mennyiért vettük) a "Beszerzések" fül alapján.
- Szóval itt többszörös feltételes keresésre lenne szükség, amivel meggyűlt a bajom. -
Ha ez is megvan, vonja ki belőle a beszerzési árat, így megkapjuk, hogy mennyi árrés maradt azon a terméken.Az "Eladások" fül végén az "Árrés" oszlopba kellene kerüljön a számolt adat, akkor egyből látszódna az eredmény.
A mintafájl: [link]
Remélem, így jobb a leírásom.
Köszönöm a segítséget.
Üdv,
Botond -
ReSeTer
senior tag
válasz
Fferi50
#47642
üzenetére
Köszönöm, eszközölnöm kellett kisebb módosítást, de működik a Range Find metódusával.
Másik:
Szeretnék beilleszteni egy Word dokumentumban lévő táblázat celláiba értékeket. A cellák üresek.
Egyszerűen nem találok rá egyszerű megoldást a google-ben.
Hogyan tudom meghatározni, hogy hova illesszen be? Van valami azonosító?Eddigi kód:
Sub openword()Set wordalkalmazas = CreateObject("word.Application")wordalkalmazas.documents.Open "elérésiút\probasablon.doc"wordalkalmazas.Visible = TrueEnd Sub -
-
Fferi50
Topikgazda
válasz
Fferi50
#47588
üzenetére
Botond187-nek a korábbi üzenet folytatása:
Az eredeti adathalmazt alakítsd át táblázattá, az első sor a fejléc.
Ezután a tömbképlet a következő:=INDEX(Táblázat1[[#Mind];[ár]];MAX((Táblázat1[[#Mind];[azon]]=$A$3)*(Táblázat1[[#Mind];[dátum]]<$AH$3)*SOR(Táblázat1[[#Mind];[azon]])))
Táblázat1: az átalakított halmaz neve.
ár: a táblázat árakat tartalmazó oszlopának felirata
azon: a táblázat azonosítókat tartalmazó oszlopának felirata
dátum: a táblázat dátumokat tartalmazó oszlopának felirata
A3 cella tartalmazza az azonosítót
AH3 cella tartalmazza a dátumot, aminél korábbit keresel
A tömbképletet Shift+Ctrl+Enter kombóval kell lezárni, az Excel kapcsos zárójelbe teszi.
Remélem, jól értelmeztem a kérdésed.
Üdv. -
lenkei83
tag
válasz
Fferi50
#47571
üzenetére
Szia Feri!
A youtube csatornájukon kerestem volna, de az nem működik. Köszi a tippet, az instán nem néztem, de ott volt a megoldás. Excel\VBA-ban van megírva.
Gyorsan felvertem VBA-ba, működik, a lenti linkről le lehet tölteni. Próbálom értelmezni...
[https://1drv.ms/x/s!Ans3TmRiC9RGhaMx1z_INz4zg7X91Q?e=lSc26r]Üdv.:
P. -
-
-
LostData
csendes tag
válasz
Fferi50
#47378
üzenetére
Köszi szépen, már majdnem jó minden!
Most abba a problémába futottam bele, hogy néhány dátumot rendben megcsinál, de a nagy részénél #HIÁNYZIK hibaüzenetet ír a cellákba.
Nem tudom ennek köze lehet-e ahhoz, hogy mivel az angol dátumok nem rövidítve, hanem teljesen kiírva szerepelnek az excelben, én a segédoszlopban az angol hónapok teljes nevét tüntettem fel.
Szerk: Igen, ha a "Közép" függvény "hány_karakter" részét úgy módosítom, hogy az pontosan megegyezzen az adott hónap karaktereinek számával, akkor rendben kiírja a dátumot.
Így viszont aszerint kéne manuálisan módosítgatnom a képletet, ahány karakterű az adott hónap? Vagy megadható a képletben mondjuk egy -tól -ig érték is, hogy a legrövidebb és leghosszabb karaktereket egyaránt tudja kezelni?Emellett úgy csináltam a "hónapok" segédoszlopot, hogy kijelöltem a 12 cellát, és úgy mentem a képletek>névkezelő>új név részhez.
Egy másik, talán kisebb probléma, hogy nem minden cellában szerepelnek dátumok, így ezeknél #ÉRTÉK hibaüzenetet kapok, de ezeket maximum kitörölgetem egyesével.
Csodálom egyébként, hogy még mindig nem adtad fel a nekem való segítést, dacára annak hogy milyen problémás vagyok..
-
LostData
csendes tag
válasz
Fferi50
#47374
üzenetére
Szia!
Félsiker!
A képleted alapján sikerült ugyanolyan formátumba kiírnom a dátumot, mint ami a te képeden az E1 cellában van, viszont mikor lehúznám addig, ameddig adatom van, akkor minden cellába ugyanazt a dátumot (1979.05.17) írja, pedig a $ jelek elvileg rendben vannak nálam is.
Ez a képletem:
-
LostData
csendes tag
válasz
Fferi50
#47372
üzenetére
Az eredeti csv fájl egy részletét képkivágással tudnám megmutatni, bár az csak néhány excel cella lenne mindenféle értékkel (pl.: azonosító szám, név, születési hely, a hibásan megjelenő születési dátum, plusz még jó néhány adat), szóval nem tudom hogy ez mennyire lenne segítség..
Ugyanígy az összefűzött sorokat is úgy tudnám elküldeni, hogy minden adatot kivágok ami a dátum előtt és után van, szóval gyakorlatilag a képen csak maga a dátum, és az előtte-utána lévő pontosvesszők maradnának, ami szintén nem tudom mennyire lehet hasznos
-
LostData
csendes tag
válasz
Fferi50
#47362
üzenetére
Pontosítanád esetleg ezt a részt?
"Ezután a segédoszlopon Ctrl+C - irányított beillesztés értéket."
A ctrl+c után az irányított beillesztésen belül mit választok ki?
Egyébként megcsináltam a segédoszlopot a képlettel, össze is rakta egy cellába az egy sorban lévő adatokat, de a szövegdaraboló előnézete így néz ki, szóval szerintem valamit rosszul csinálok:
itt már nem a tényleges értékeket kéne látnom?
-
LostData
csendes tag
válasz
Fferi50
#47358
üzenetére
Ismét köszi a segítséget!
A 3. verzió szerintem azért nem lenne jó, mert nekem a rossz dátumok nem egymás mellett egy sorban, hanem egymás alatt vannak egy oszlopban.
Egyébként sajnos nem igazán sikerül a dolog, túl béna vagyok még a legegyszerűbb műveletekhez is, de majd még próbálkozom..
-
LostData
csendes tag
válasz
Fferi50
#47356
üzenetére
Köszönöm szépen a választ!
Mivel az első megoldás tűnt elsőre a legegyszerűbbnek, ezért azzal próbálkozom most, de a VB-n belül hogy adom meg, hogy melyik adat milyen formátumban kerüljön be?
Most használok először VB-t, szóval gondolom Google a barátom, de azért gondoltam megkérdezem..
-
spe88
senior tag
válasz
Fferi50
#47285
üzenetére
Valóban, csak akkor meg némelyiknél annyi tizedesértéket mutat, hogy felesleges és átláthatatlan.
Úgy akartam volna beállítani, hogyha tört az érték, akkor egy tizedesig jelenítse meg, ha nem, akkor ne jelenítsen meg tizedesértéket.Durva volna, ha ezt nem lehetne benne beállítani, bár lehet.
-
andreas49
senior tag
válasz
Fferi50
#47242
üzenetére
Szia,
A keres/cserél (Ctrl+F) -hez hasonló bevitel és kezelés lenne az ideális. Valószínűleg ez egy nagy és bonyolult makró lenne. Lehet, hogy meg kellene barátkoznom a 'Kutools' féle megoldással. Az a baj, hogy ahhoz elég kevés az angol nyelvtudásom. A részcserélés elhanyagolható végül is. -
andreas49
senior tag
válasz
Fferi50
#47240
üzenetére
Szia,
Több olyan Excel fájlom van ami neveket tartalmaz. Ebben kellene keresnem az egységesítéshez és cserélni. Ez minden esetben cellatartalom, néha csak egy része.
pl. egyik mező jk istván, itt csak a jk-t kell valamire cserélni. A legtöbb esetben cellatartalom.
Egyszerre kellene a megnyitott munkafüzetekben keresni és cserélni.
'Mosta Pista': azt ismerem, de fizetős (Kutools) -
detroitrw
addikt
válasz
Fferi50
#47180
üzenetére
Köszi a reszletes infokat.
Akkor majd a pontot pontra cseret fogom beirni a VB-be
(igy nem kell attol tartani, hogy esetleg a szovegek tartalmat megvaltoztatja).Az zavart meg, hogy alapbol datum cella tulajdonsagu az adott cella, aztan csak kesobb esett le, hogy nem tartozik hozza "ertelmetlen" szam, igy igazabol nem is lehet datum ...
-
Fferi50
Topikgazda
válasz
Fferi50
#47124
üzenetére
Kiegészítés a 41721-re adott válaszhoz.
Bocs, a második sor képlete más egy kicsit.
A2 cella képlete:
=INDEX(Munka1!$A$1:$J$8;SOR()+SOR(A1);OSZLOP()+1)
A B2 cella képlete:
=INDEX(Munka1!$A$1:$J$8;SOR()+SOR(A2);OSZLOP())
Ezt együtt lehet jobbra húzni és utána a sort lefelé is.
Túl gyorsan válaszoltam. -
MostaPista
tag
válasz
Fferi50
#47119
üzenetére
Szia,
angol exc 2003, hogy ne legyen tipus kodolasi problema, ugye pont es vesszo a szamoknal, datum, stb.Koszonom a valaszokat, majd holnap megnezem oket, csinaltam egy gyors kepet a publikussa teheto reszerol, igy nez ki, lenyegeben a fejlec is ket soros es ket soronkent vannak az adatok is minden masodik oszlopban, ezekbol kellene egy sort csinalnom valahogy.
A szamok jobbra vannak utkoztetve, es azt irja, hogy szamok, de amikor alul sum-ot beirok, mindig nulla a vegeredmeny.
Furcsa.:-( -
spe88
senior tag
válasz
Fferi50
#47107
üzenetére
Köszi, sejtettem. Bonyolódik, akkor a helyzetem rendesen.
Csináltam egy képletet, ami megmutatja melyik az első üres sor. Makróval akarok beilleszteni alá egy sort, de nem megy. Ezzel próbálkozom. Ki tudnátok javítani? A7 cellában van az érték, ami megmutatja az első üres sort.
Sub Makró2()'' Makró2 Makró''Rows("indirect(a7):indirect(a7)").SelectSelection.Insert Shift:=xlDownSelection.ClearFormatsEnd Sub -
#47033
EroSennin79
újonc
Fferi50
#47032
EroSennin79
újonc
válasz
Fferi50
#47032
üzenetére
Hihetetlen vagy, nagyon szépen köszönöm. Hatalmas segitség volt. El sem hiszem már készen is vagyok
Póbálom magamat képezni de egyedül kissé nehézkes.
Még egy kérdésem lenne. Ha a formula eredménye 0 akkor az excel mindig #DIV/0 hibát ir. Ezt IF funkcióval szoktam nullázni. Van valami más egyszerübb módja hogy ne legyen a nullától rosszul ? Például ennél a formulánál?
=Statistic!W41/Statistic!Z41 -
zsolti_20
senior tag
válasz
Fferi50
#47000
üzenetére
Köszönöm szépen a jobbnál jobb kódokat.
Linkelek ide egy képet, az A oszlopban vannak az értékek, B oszlop Delila_1 gyártott kód eredménye C oszlop Fferi50 kódjának eredménye.Ahogy látom a Fferi50 a te kódodnál végülis mindegy mennyi elválasztás történik, az utolsó tömb értéke elé lesz beszúrva a "." aztán össze fűzzük a maradékot. Így a forrás lehet bármekkora, működni fog.
-
MostaPista
tag
válasz
Fferi50
#46990
üzenetére
Amit irtal, az van a bal oldalon, az az indulo.
A jobb oldalit kellene elernem, de nem sikerul ezzel a modszerrel.
Talan ugy kellene, hogy ossze kellene vonni az elso kettot, hogy "fajlnev es konyvtar" szerint rendezzen?Privatban kuldom a peldat.
PS:
Barki mas, akit erdekel, kuldon neki privatban, ide csak kepet tudok feltolteni.Kilove, privatban is csak kepet enged kuldeni.
-
csferke
senior tag
válasz
Fferi50
#46955
üzenetére
Szia!
Az volt az alap feltételezésem, hogy a Vlookup nem is ad találatot akkor is az Excel úgy tekint a cellára, hogy nem üres hiszen benne van a képlet.
Hosszas próbálkozás folyamán jött ez a képlet
=IF(VLOOKUP(I5;Vevok!A:Q;17;0)="";"";VLOOKUP(I5;Vevok!A:Q;17;0))
Amikor az első Vlookup nem ad eredményt akkor kitölti a cellát "üressel" ha viszont van találat akkor a második Vlookup beírja a találatot. Erre már működik a feltételes formázás.Ki fogom próbálni a te képleted is. Mindig tanul valamit az ember.
köszönöm
-
#46970
Apollo17hu
őstag
Fferi50
#46968
Apollo17hu
őstag
válasz
Fferi50
#46968
üzenetére
Nah, úgy néz ki, sikerült. Köszönöm a tippeket.
Leválasztottam az összes szeletelőt a pivotokról, utána a pivot forrását módosítottam, majd visszacsatoltam a szeletelőket. Most megnyitva a fájlt már nem dobja a biztonsági üzenetet.
Viszont a jövőre nézve nem tudom, milyen módszerrel lehetne hatékonyan azonosítani ezeket a hibás kapcsolatokat, mivel ezek nem cellákban vannak tárolva, tehát a [Ctrl] + [F] nem működik. Esetleg - ha a mostani után lesz még hozzá kedvem
- próbálok keresni vmilyen makrót a neten, ami a fájlban szereplő pivotok adatforrásait listázza, mert abból lehetne látni a hibát.
De leesett a tantusz és úgy más minden 
volt. 
,"<>")),D2)>1,"no","yes") függvénnyel van meghatározva, ami eddigi tesztjeim alapján dinamikusan változik, amikor ugyanaz az elérési útvonal kerül a Path oszlop celláiba. Amennyiben az adott elérési útvonal nem ismétlődik többet a maradék cellatartományban az érték Save&Close "yes"-re változik és a workbook ment és bezárul
Új hozzászólás Aktív témák
Hirdetés
- Sütés, főzés és konyhai praktikák
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- AMD vs. INTEL vs. NVIDIA
- Bambu Lab 3D nyomtatók
- Nem fogy a Galaxy S25 Edge?
- Vezetékes FEJhallgatók
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Autós topik
- Anglia - élmények, tapasztalatok
- Nagyrobogósok baráti topikja
- További aktív témák...
- Azonnali kézbesítés az év bármely pillanatában
- HUAWEI MateBook 13 2020 - Kijelző nélkül - I7-10510U - 16GB - 512GB SSD - Win11 - MAGYAR
- LG 65QNED87T / 65" - 164 cm QNED / 4K UHD / 120Hz & 3ms / HDR 10 Pro / FreeSync Premium / HDMI 2.1
- Csere-Beszámítás! Számítógép PC Játékra! I5 14400F / RTX 4060ti 16GB / 32GB DDR5 / 1TB SSD
- AKCIÓ! Gigabyte H610M i5 12400F 16GB DDR4 512GB SSD RX 6700XT 12GB Zalman S2 TG Seasonic 650W
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PC Trade Systems Kft.
Város: Szeged