Köszönöm, de hogyan is nézzen ki az a képlet?

Rinderkennzeichnungsfleischetikettierungsüberwachungsaufgabenübertragungsgesetz

Szia!
A makrónak mindig igaza van sajnos.
A
For x = 1 To 200000 - 1
sorban a 200000 helyett légy szíves írj y-t.
For x = 1 To y - 1
Mivel kevesebb sorral nem teszteltem, így maradt benne sajnálatosan.
Üdv.

Szia!

Műűködik!

Egyéként próbálgatás közben feltűnt, hogy Notepad++ több értéket talál duplikációként, mint az excel.
Van egy Scrapebox nevű program, ami szinten eltérő mennyiségben talál duplikált értéketet mint az excel és a Notepad++..

Szia!
Azért remélem, hogy az Excel által talált duplikáció az igazi.
Persze ne feledjük, hogy az 123 szöveg és a 123 szám az nem egyforma az Excelben, ebből lehet eltérés.
Gondolom, a sorozatszámaidban betű is van és akkor nem játszik az előző megjegyzésem.
Üdv.
Ps. Remélem, könnyebb lesz az életed vele.

Szia,
Én is. Majd ellenőrizni fogom valami módon. Igen, betűk és számok vannak a sorozatszámokban.
Köszi!

Arra van még esetleg javaslat, hogyan kellene módosítani úgy a makrót, hogy a duplikált értékeket átmásolás helyett áthelyezze (azaz szedje is ki a D oszlopból) az M oszlopba?

Sziasztok!

Egy látszólag egyszerű probléma megoldásához kerestem képletet.
Adott egy 30-31 értékes sor, ami utolsó 5 értékének az átlagát szeretném kiíratni.
Ezek a hónap napjait jelölik, minden nap új érték kerül felvitelre az aktuális nap alá, mely lehet 0, bármilyen más szám vagy maradhat üresen is.
Elsősorban szerettem volna kitalálni, hogyan lehet képletbe foglalni azt, ha mindig van érték. Az üressel vagy nullával bonyolításig el sem jutottam (egyelőre nem tudom, hogy a nullát bele akarom-e venni vagy tekintsen rá "üresként"), valamint ahhoz sem tudtam ezáltal hozzászagolni, hogy kezelje azt a helyzetet, mikor kevesebb, mint 5 érték van a sorban.

Feltöltöttem a Teszt munkafüzetet ide: [Google Drive], és csatolok képernyőmentést is: [kép].
A probléma az, hogy ha a legelső, ha az utolsó cella értékeit módosítom, az hatással van az átlagra, ami az egésznek a lényegét dönti romba. Akkor találtam és implementáltam olyan egyenletet, ami egy sor üres cellára is értéket hozott. Olyat, ami ugyanezekre a számokra 40.000 feletti eredményt mutatott, de ezt módosítva sikerült elérni, hogy egész számokból képtelen törtek legyenek...

Tudnátok adni iránymutatást? Google-ben kerestem megoldásokat, de némelyik túlontúl bonyolultnak tűnt.

Otthon: Windows 10, Professional Plus 2019
Munkahelyen: Windows 10, Office 2016 - mindkettő magyar nyelvű

Köszönöm szépen!

Don't give up your dreams. Keep sleeping.

Ezt nézd meg

Bámulatos hol tart már a tudomány!

Szia!
Íme:
Sub valogato()
Dim a, x As Long, y As Long, u As String, d, v As String
ActiveSheet.UsedRange.Columns("A").Copy Range("D1")
y = ActiveSheet.UsedRange.Rows.Count
Debug.Print "sort indul:" & Time
With Range("D1:D" & y)
.Sort key1:=Range("D1"), Header:=xlNo
Debug.Print "sort vége:" & Time
a = .Value
End With
u = ""
Debug.Print "Keresés indul: " & Time
d = ""
For x = 1 To y - 1
If a(x, 1) = a(x + 1, 1) Then
If d = "" Then
u = u & ";" & a(x, 1): d = a(x, 1)
Else
If a(x + 1, 1) <> d Then u = u & ";" & a(x, 1): d = a(x, 1)
End If
Else
If a(x, 1) <> d Then v = v & ";" & a(x, 1)
End If
DoEvents
If x Mod 1000 = 0 Then Application.StatusBar = "Készen van eddig " & x
Next
If a(x, 1) <> d Then v = v & ";" & a(x, 1)
Debug.Print "Keresés vége:" & Time
u = Mid(u, 2): v = Mid(v, 2)
a = Application.Transpose(Split(u, ";"))
Range("M1:M" & UBound(a)).Value = a
a = Application.Transpose(Split(v, ";"))
Range("F1:F" & UBound(a)).Value = a
Debug.Print "Visszaírás vége: " & Time
Application.StatusBar = False
MsgBox "Készen vagyunk"
End Sub
Az F oszlopba írja ki az ismétlődés nélküli értékeket.
Üdv.

Sziasztok!
Az kivitelezhető, hogy automatikusan változzon egy lapfül neve?
Konkrétabban. "Név "+ egy másik lapon található cella tartalma, amely változik.

köszi
Angol Excel 2007

Szia!
Közben találtam egy makró nélküli megoldást is, de ehhez pár műveletet el kell végezni :
1. Legyen az A oszlopnak fejléce - mondjuk Sorozatszám
2. Beszúrás - kimutatás - új lapra
Sorozatszám mező a Sorokhoz
Sorozatszám mező az Érték területre - mennyiség Sorozatszám
Elfogadható időn belül kész a kimutatás!
3. Az egész kimutatást a végösszeg sor nélkül kijelölni - beillesztés értéket egy új területre az új lapon.
4. Szűrő bekapcsolása az átmásolt adatokra
5. Szűrő - csak az 1 bekapcsolva - az egyedi értékek lesznek. Sorozatszám másolás - irányított beillesztés értéket - oda, ahol látni szeretnéd az egyedi sorozatszámokat

6. Szűrő - átállítás az 1 kivételével minden - az ismétlődő értékek maradnak. Sorozatszám másolás - irányított beillesztés - oda, ahol az ismétlődéseket szeretnéd látni.

Kétszázezer sorral kevesebb ideig tartott, mint ide leírni!
Persze usert ilyenre kérni nem lehet, tesztelem a hozzá kapcsolódó makrót, ha kész lesz felmásolom.
Üdv.

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

Komment írás közben tesztekett futtatam, azért nem tűnt fel ez a tipp. Nézem ezt is!

Szia!
Én az egyik futásnál ellenőriztem, hogy megvan-e mind a kétszázezer szám (ismétlődések összeadva + az egyedi) pontosan megvolt.
A pivottáblás makró, feltételek:
Első futtatásnál:
Csak 1 munkalap legyen a munkafüzetben, amelyiknek az A oszlopában ott vannak a számok. A1 cella fejléc.
Ekkor a makró létrehoz egy nevet - forras - a névkezelőben, ami beállítja a pivot forrását
Ezután létrehoz egy új munkalapot, arra a pivottáblát.
Az új D1 cellájától kezdve átmásolja a pivot eredményét.
Szűri 1 -re (azaz egyediek) - átmásolja az első munkalap D oszlopába
Szűri >1-re (azaz ismétlődők) - átmásolja az első munkalap F oszlopába
Ez kb. fél perc 200000 tételnél.
Ha a továbbiakban a változások kezelésére is ezt szeretnéd használni, akkor nincs más teendő, mint az új sorozatszámokat hozzáírni/felülírni az első munkalap A oszlopában, majd jöhet a
második/sokadik futtatás
Fontos! Ebben az esetben is az első munkalapon kell állnod, amikor a makrót indítod.
Az előző futás eredménye felülíródik a D és F oszlopokban.
Íme a makró:
Sub tablas()
Dim sh1 As Worksheet, sh2 As Worksheet, pvt As PivotTable, tblsource As String, pvtfname As String, nm As Name
Application.ScreenUpdating = False
Set sh1 = ActiveSheet: pvtfname = sh1.Range("A1").Value
If Names.Count > 0 Then
Set nm = Names("forras")
End If
If nm Is Nothing Then Set nm = ActiveWorkbook.Names.Add(Name:="forras", RefersTo:="=OFFSET(" & sh1.Name & "!$A$1,0,0,COUNTA(" & sh1.Name & "!$A$1:$A$300000),1)")
If Sheets.Count = 1 Then
Set sh2 = ActiveWorkbook.Sheets.Add(after:=sh1)
Else
Set sh2 = Sheets(2)
End If
tblsource = Replace(Evaluate(Names("forras").RefersTo).Address(ReferenceStyle:=xlR1C1, external:=True), "[" & sh2.Parent.Name & "]", "")
If sh2.PivotTables.Count = 0 Then
Set pvt = sh1.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tblsource, Version:=6).CreatePivotTable(tabledestination:=Replace(sh2.Range("A1").Address(ReferenceStyle:=xlR1C1, external:=True), "[" & sh2.Parent.Name & "]", ""), TableName:="Srszamok", Defaultversion:=6)
pvt.AddDataField pvt.PivotFields(pvtfname), "Darabszám", xlCount
pvt.PivotFields(pvtfname).Orientation = xlRowField
Else
Set pvt = sh2.PivotTables(1)
pvt.RefreshTable
End If
With sh2.Range("D1")
If .Value <> "" Then .CurrentRegion.ClearContents
If sh1.Range("D1").Value <> "" Then sh1.Range("D1").CurrentRegion.ClearContents
If sh1.Range("F1").Value <> "" Then sh1.Range("F1").CurrentRegion.ClearContents
.Resize(rowsize:=pvt.TableRange1.Rows.Count, columnsize:=pvt.TableRange1.Columns.Count).Value = pvt.TableRange1.Value
With .CurrentRegion
.AutoFilter field:=2, Criteria1:="1"
.Columns(1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("D1")
.AutoFilter field:=2, Criteria1:=">1"
.Columns(1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("F1")
.AutoFilter field:=2
End With
End With
sh1.Range("D1").Value = "Egyedi": sh1.Range("F1").Value = "Ismétlődő"
sh1.Activate
ActiveWindow.ScrollRow = 1
Range("D1").Select
MsgBox "Készen vagyunk!"
Application.ScreenUpdating = True
End Sub
Üdv.

Sziasztok,

Ha van egy oszlopban egy adag számom, hogy tudom megoldani, hogy pontokkal legyenek elválasztva hármas csoportonként? Mert ha számformátumba állítom, akkor a szeparátor betesz szóközöket közéjük, addig oké, de nekem nem szóköz kéne oda, hanem pont karakter.
Ráadásul amit a szeparátor csinál, az nem is igazi szóköz, mert a replace all parancsal sem tudom kicserélni őket, szerinte nincs ott semmilyen szóköz. (ebből ered a probléma is, amiért pontot akarnék, mivel körlevélbe kellenének a számok, és ahogy oda behúzza az adatokat, mivel nem igazi szóköz, már egybe teszi az összes számot)

Ha a multiverzum teória igaz, akkor van egy univerzum, ahol nem az.

https://spreadsheetplanet.com/format-phone-numbers-excel/
de valószínű hogy előtte át kell állítani a , -t pontra a beállításokban

Bámulatos hol tart már a tudomány!

Szia!
A körlevélben - gondolom Word - szerintem a mezőnél /Mergeformat kapcsolóval tudod beállítani, hogy a körlevélben hogyan jelenjenek meg a számok és a dátumok.
Üdv.

Köszönöm, próbálkozom, bár úgy tűnik ez fixen tesz be annyi karaktert pozíciókra, amennyi be van írva, és persze nekem változó hosszúságú számértékek vannak (százezres,milliós,tízmilliós) így nem mindig ugyanannyi karakterhosszal kell dolgozni, ha ez nem lenne elég

Fferi50: köszi, megnézem azt is

[ Szerkesztve ]

Ha a multiverzum teória igaz, akkor van egy univerzum, ahol nem az.

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!

Szia!
If Sheets.Count = 1 Then
Set sh2 = ActiveWorkbook.Sheets.Add(after:=sh1)
Else
Set sh2 = Sheets(2)
End If
Ez a rész akkor ad hozzá új munkalapot, ha csak egy lap van a munkafüzetben. Ha több, akkor a második munkalapot használja - amin elvileg az első futás után a pivot keletkezik.
Ugye első futás előtt követelmény, hogy csak 1 munkalap legyen a füzetben, így a futáskor létrehozott munkalap lesz a második.
Ismételt futás után már nem kell a pivotot létrehozni, az ott van a második munkalapon, csak aktualizálni kell.
If .Value <> "" Then .CurrentRegion.ClearContents
If sh1.Range("D1").Value <> "" Then sh1.Range("D1").CurrentRegion.ClearContents
If sh1.Range("F1").Value <> "" Then sh1.Range("F1").CurrentRegion.ClearContents
Ez a 3 sor törli a második munkalap D1-es területét és az első munkalap D1 és F1 oszlopát.
Szerintem nem lenne szükség törlésre.
Mi miatt volt nálad a külön törlésekre szükség?
Üdv.

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.

Én is darabtelivel szórakozok:

B1 képlete: =IF(COUNTIF(A1:A$7,A1)>1,"yes","no")

A vastaggal kiemelt részt hogyan tudnám változtatni annak függvényében, hogy beviszek-e újabb adatot A8-ba?

Valami hasonlóra gondolok:
=IF(COUNTIF(A1:A&lastrow,A1)>1,"yes","no")

Egyszer már véletlenül kigugliztam, de ma az istenért sem találom.

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

Szia!
Pl.
IF(COUNTIF(OFFSET($A$1,0,0,COUNTA($A1:$A1000),1),$A1)>1,"YES","NO")
Üdv.

https://exceljet.net/formula/countifs-with-variable-range
Dinamikus tartomány

Bámulatos hol tart már a tudomány!

Szia!

=HA(DARABTELI(A1:INDIREKT("A" & DARABTELI(A:A;"<>"));A1)>1;IGAZ;HAMIS)
Gondolom át tudod alakítani angolra

Nagyon szepen koszonom, ez lesz egyelore a befuto, meg kell meg neznem, hogy nagyobb cellatartomanyon nem-e okoz lassulast
lappy es Fferi50 koszonom nektek is, nem gondoltam, hogy ilyen keson meg valaki reagal

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

Táblázattá alakítva a tartományodat egyszerű a képlet, és új sort hozzáadva automatikusan kitöltődik a B oszlop.

Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

Köszönöm, de nem pontosan ilyen formában kerestem a duplikációt.
Van egy vba ciklusom, fentről lefelé halad, ezért nem releváns, hogy a tartomány felső részében található-e a duplikáció, lényeg, hogy a maradékban ne legyen, erre tökéletes volt Pakliman formulája, szerencsére működik ez is automatikusan, ha táblává alakítom. egyébként örök hálám az ötletért, megmentettél egy kör guglizástól

Valós felhasználása egyébként az lesz, hogy B oszlopban lesznek elérési útvonalak, többi oszlopban különböző paraméterek a ciklusnak, és az utolsó oszlopban lesznek tárolva a válaszok a Save&Close-ra. Ha az adott fájlt később még használja a ciklus, akkor nyitva hagyom (válasz no), ha nem akkor mentés és zárás (yes), példában pont fordítva kérdeztem, de az már csak részletkérdés.

Ezzel kapcsolatban meg is érkeztem ma esti fejtörőmhöz:

Ciklusomban egy bizonyos ponton elérkezek a nyomtatáshoz

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

Majd ezután megvizsgálom, hogy Save&Close "yes"-e?

If CStr(saveandclose) = "yes" Then
            Excel.Workbooks(fileName).Close SaveChanges:=True
            Else: GoTo nextraw
            End If

Itt kezdődnek a bajok, a kettő közé kellene valami, ami megakasztja a cilkus további futását, amíg ez az ablak be nem záródik.

Ugyanis, ha várni kell a nyomtatóra valamiért, akkor az ciklus egyszerűen bezárja a fájlom még mielőtt el lett volna küldve a nyomtatóra.

Próbáltam ezt, wordben ok, de sajnos excelben nem működik:

While Application.backgroundPrintingStatus > 0
        Application.Wait (Now + TimeValue("00:00:01"))
Wend

Simán Application.Wait-et sem akarok használni, mert akkor 1000 évig tartana, míg végez a ciklus, plusz azt sem tudom mennyi időt kellene pontosan meghatároznom.

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

Szia!

Egy ilyen kódot találtam.
Nem tudom, műxik-e, nem próbáltam
Van benne egy JobsDesc(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 ]

Do While ActiveWindow.View = xlPrint
        'Application.Wait (Now + TimeValue("00:00:01"))
Loop

Először Application.Wait-tel próbáltam, de még az is felesleges a boldogsághoz
Egyelőre csak itthon tudtam kipróbálni, majd hétfőn meglesem melóban is, hogy a valóságban is működik-e?

[ Szerkesztve ]

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

"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 Sub

Ez 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 Sub

Ez 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

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

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.

Átírtam, kb 1 másodperc gyorsulast hozott, ami meg sokkal tobb is lesz, mire minden sor fel lesz toltve a tablaban. Azert irtam eredetileg igy, hogy minden lepest lathassak lebontva, mikot a step into-t hasznalom

"-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

Sziasztok,
Bár nem excel, hanem google sheet kérdés, de remélem azért maradhat.

Szeretnék olyan megoldást, mint amit néhány weboldalon láttam:
Jobb klikk másol és ctrl+c tiltva van az adatok ellophatósága végett.

Ez megolható google felületen, vagy csak html kódban működhet?

Segítséget előre is köszönöm!
Üdv: Dani

https://oit.ncsu.edu/2015/08/17/disable-download-print-and-copy-features-for-google-files-2/

Bámulatos hol tart már a tudomány!

Köszönöm, nem gondoltam, hogy be van építve ilyen

Sziasztok!

A DÁTUMTÓLIG fügyvényt szeretném használni, de nem találom az excelben.
Hogyan tudom megívni ezt a függvényt?

milyen verziójú az exceled?

Bámulatos hol tart már a tudomány!

2016

Sziasztok!
A NAPOK nevű fügvény megcsinálja amit én szeretnék de a táblázat amit kapok a dátum így szerepel 29/11/2021 napost ezzel nem akar nagyon együtt működni, hogy lehet konvertálni az ilyen jellegű dátumot mondjuk 2021.11.29-re?

Szia!
Biztos, hogy dátum az amit ott kapsz? Szerintem szöveg, csak dátumnak gondolod.
Nézd meg a cellaformátumot légy szíves és próbáld átállítani számra.
Ha szám lesz belőle, akkor dátum és csak formátumot kell változtatni.
Ha marad ilyen, akkor szöveg és függvényekkel tudod dátummá alakítani segédoszlopban, pl.
=Dátum(jobb(A1;4);közép(A1;4,2);bal(A1;2))
Üdv.

Köszönöm szépen!

Helló!

Lehet olyat csinálni VBA-ban, hogy csinálok egy sablon kódsort, és azt behívom máshol ott megadott értékekkel?

Sablonkod()

A=
B=
Sor=
Oszlop=
Muvelet=A+B

Cell(Sor,Oszlop).Text=Muvelet

End Sablonkod

És akkor ezt így használnám egy másik kódban:

Masikprogram()

Call Sablonkod(A=4,B=8,Sor=1,Oszlop=3)

End Masikprogram

Bocs, tudom, hogy ez így nem helyes, még tanulom a VBA-t, de remélem a lényeg átjön.
Lehet ilyet csinálni? Valami olyat találtam, hogy egy funkció visszaad egy változót, de nekem nem kell, hogy visszaadjon bármit is, inkább csináljon valamit, mint pl fent, hogy átír egy cellát.

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, akkor
If 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.

Szia!
Természetesen lehet. Paraméteresként kell létrehoznod a "sablon" eljárást (vagy függvényt ez utóbbi esetben tudsz értéket visszakapni.)
Itt nézhetsz utána hogyan kell
Üdv.

[ Szerkesztve ]

Sziasztok!
Az alábbi kérdéssel fordulnék hozzátok:
Egy oszlop értékeit összeadom egy cellában =SZUM(B1:B33)
Most én hozzá szeretném adni egy másik oszlop adatait is pl. az F és G oszlopét is (sorok számai ugyanazok)

Egy másik:
Hogyan lehetne beállítani egy cellánál, hogy amíg nem éri el a pozitív értéket a számok mennyisége, addig ne jelenítsen meg negatív számot, hanem 0 legyen ott addig amíg nem ér pozitívba?
Köszönöm!

=SZUM(B2:B33;F2:G33)

=HA(C2-C4<0;" ";C2-C4)

[ Szerkesztve ]

Bámulatos hol tart már a tudomány!

Köszi!
A második kérdésem sora most így néz ki (amit megadtál nem tudtam beilleszteni magamnak):

=D35-H45

(Ha a H45 értéke nagyobb mint ami a D35-ben van akkor ne legyen negatív szám megjelenítés, csak 0,0 amíg D35 nem lesz nagyobb mint H35

[ Szerkesztve ]

Helló!

Fel lehet valahogy használni egy funkción belüli változót a főmakróban?

Function peldafunkcio (a as integer, b as integer) as integer

peldafunkcio=a+b
eztakaromfelhasznalni=a-b

End Function

Sub fomakro()

egyebvaltozo=valami+eztakaromfelhasznalni

End Sub

Ezt így nem lehet, mert üresen áll a "eztakaromfelhasznalni" váltózó miután visszatér a program a fomakro-ba.

=HA(H45-D35<0;" ";H45-D35)

Bámulatos hol tart már a tudomány!