-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Pakliman
tag
válasz
Fferi50
#54207
üzenetére
Legalább 25 éve foglalkozom az Excel-el és nagyon sok (több százezer) sort írtam már meg, de az "osztályosdit" mindig kerültem. Most úgy gondoltam, hogy talán hasznomra válhat, mert eddig úgy csináltam, ahogy írtad is:
esetleg megoldható lenne az esetek számának megfelelő vezérlő létrehozása
.
Ha nem tudok kódból triggerelni egy eseményt, akkor maradok a régi bevált módszernél.
Esetleg lehetne úgy is, hogy dinamikusan létrehozom a vezérlőt és vele együtt VBE-be a megfelelő kódo(ka)t...
Vagy még előtte teszek egy (két, há sok...) próbát a .Value (vagyis a .Change esemény) változtatásával
-
Pakliman
tag
válasz
Fferi50
#54202
üzenetére
Szia!
A júzer kattintgat ide-oda-amoda, ezek alapján megváltozik (vagy nem!) az opb lista. Az éppen aktuális állapotnak megfelelően az opb listában automatikusan ki kellene választódnia a "legrelevánsabb" opciónak (itt kellene kódból meghívnom a Click eseményt!), amit viszont a júzer bármikor felülírhat. A kiválasztás hatására más dolgok megint csak változnak, amiket a Click-re programoznék.
-
Pakliman
tag
Sziasztok!
Segítséget kérnék VBA problémával kapcsolatban, amivel eddig egyáltalán nem foglalkoztam (Classmodul), mert nem volt rá szükségem. Most viszont másképp nem lehet megoldani a dolgot (legalábbis "egyszerűen" nem)...
Egy Formon dinamikusan hozok létre változó mennyiségű OptionButton-t.
Hogyan tudom "elindítani" programból ezeknek a Click eseményét anélkül, hogy az egérrel vagy billentyűvel ténylegesen kattintanék?Ami megvan:
clsOPB:Option Explicit
Public WithEvents OptionButton As MSForms.OptionButton
Private Sub OptionButton_Click()
UserForm1.Label1.Caption = OptionButton.Parent.Name & ": " & OptionButton.Name
End SubUserForm1:
Private opbArray() As New clsOPB
Private Sub CommandButton1_Click()
Dim ctl_OpB As MSForms.OptionButton
Dim i As Long
ReDim opbArray(1 To 3)
For i = 1 To 3
Set ctl_OpB = Me.Controls.Add("Forms.OptionButton.1", "opbXYZ" & i, False)
With ctl_OpB
.Left = 100
.Top = 150 + (i * 20)
.Width = 100
.Caption = "opb_" & CStr(i)
.Visible = True
If i = 1 Then
.Value = True
' .Click 'HIBA!! Object doesn't support this property or method
End If
End With
' ctl_OpB.Click 'HIBA!! Object doesn't support this property or method
Set opbArray(i).OptionButton = ctl_OpB
' opbArray(1).Click 'HIBA!! Method or data member not found
' OptionButton_Click 'HIBA!! Sub or function not defined
Set ctl_OpB = Nothing
Next i
End Sub
Private Sub CommandButton2_Click()
Me.Controls("opbXYZ2").Enabled = Not Me.Controls("opbXYZ2").Enabled
End SubMár próbáltam azt is, hogy a Change eseménybe írtam be a szükséges dolgokat, de hiába változtatom meg KÓDBÓL a Value értékét, a Change esemény nem aktiválódik
Biztosan van megoldás, de eddig nem találtam meg
Tudna valaki segíteni? -
Pakliman
tag
Szia!
Valószínűleg a hiba a Windows dátumformátum beállításában van (nekem ez volt!).
A rövid dátumformátum (nem tudni miért) fölösleges szóközöket tartalmaz a pontok után.
Pl.: 2023. 03. 21 (a 2023.03.21 helyett!)
Beállítás:
Vezérlőpult->Megtekintés a következő szerint: Kategória -> Dátum-, idő- és számformátumok módosítása->(lent) További beállítások->Dátum->Rövid dátumforma->törlöd a fölösleges szóközöket->Ok -
-
Pakliman
tag
válasz
istvankeresz
#50023
üzenetére
Szia!
Egy pl. a billentyű(k) tiltására/átengedésére:
Private Sub tbValami_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub -
Pakliman
tag
válasz
bozsozso
#49244
üzenetére
Jónak tűnik, viszont én egy változóba menteném a régi értéket.
Sub Próba()
Const sep = ","
Dim utvonal As String
Dim b As String
Dim FileNum As Integer
Dim DestFile As String
Dim vLastRow As Long
Dim ki As String
Dim i As Long, j As Long
Dim mentett As String
vLastRow = Range("AD" & Rows.Count).End(xlUp).Row
'A sorba rendezés
Columns("A:AD").Sort Key1:=Columns("AD"), Header:=xlYes
mentett = ""
bezárni = False
For i = 2 To vLastRow
b = Cells(i, "AD")
If mentett <> b Then
'"Változott" az AD cella értéke, tehát...
If FileNum <> 0 Then Close FileNum '...bezárjuk az előzőleg megnyitott fájlt
mentett = b 'Az új értéket elmentjük
utvonal = "E:\teszt\" & b & "\"
If Dir(utvonal, vbDirectory) = "" Then MkDir (utvonal)
DestFile = utvonal & "teszt.TXT"
FileNum = FreeFile()
Open DestFile For Append As #FileNum
End If
ki = "7000" & sep & b & "_" & ". stb... amit akarsz..."
Print #FileNum, Left(ki, Len(ki) - Len(sep))
Next i
If FileNum <> 0 Then Close FileNum 'A végső lezárás...
End Sub -
Pakliman
tag
válasz
bozsozso
#49224
üzenetére
Szia!
Egy lehetőség (sok [több ezer!] sor esetén kicsit lassabb):
Az "utvonal" változóba beépíted az AD oszlopban lévő adatot.
Pl.: utvonal = "E:\teszt\" & Cells(i, "AD") & "\".
Ez után APPEND-el megnyitod az abban a mappában lévő "teszt.TXT" fájlt (ha nem létezik még, akkor az APPEND létrehozza!):Open DestFile For Append As #FileNum
Beírod a megfelelő adatokat az ÉPPEN AKTUÁLIS sorból, majd RÖGTÖN LEZÁROD a fájlt!!!:Close FileNum
Az Open előtt természetesen mindigFileNum = FreeFile()Célszerűbb szerintem inkább a For... Next ciklust használni, hiszen ismered az első és utolsó sor számát is.
Sub Próba()
Const sep = ","
Dim utvonal As String
Dim b As String
Dim FileNum As Integer
Dim DestFile As String
Dim vLastRow As Long
Dim ki As String
Dim i As Long, j As Long
vLastRow = Range("AD" & Rows.Count).End(xlUp).Row
For i = 2 To vLastRow
b = Cells(i, "AD")
utvonal = "E:\teszt\" & b & "\"
If Dir(utvonal, vbDirectory) = "" Then MkDir (utvonal)
DestFile = utvonal & "teszt.TXT"
FileNum = FreeFile()
Open DestFile For Append As #FileNum
ki = "7000" & sep & b & "_" & ". stb... amit akarsz..."
Print #FileNum, Left(ki, Len(ki) - Len(sep))
Close FileNum
Next i
End SubA megfelelő mappa létezését pedig a DIR paranccsal tudod ellenőrizni. Ha nem létezik, letrehozod.
-
Pakliman
tag
válasz
zoombiee
#48814
üzenetére
Szia!
Egy "lista összevonási" lehetőség:
Munka1 munkalap A oszlopban értékek
Munka2 munkalap A oszlopban értékek
Munka3 munkalap az "összesítő":
A1 -> =DARABTELI(Munka1!A:A;"<>")-1 Munka1-en az értékek száma
B1 -> =DARABTELI(Munka2!A:A;"<>")-1 Munka2-n az értékek száma
C2-től -> =HA(SOR()-1<=$A$1;Munka1!A2;HA((SOR()-1)-$A$1<=$B$1;INDIREKT("Munka2!" & CÍM((SOR()-$A$1);1;;1));""))Az A1-ben és B1-ben lévő képletek beépíthetők a C2-be.
-
Pakliman
tag
"Azoknál a kijelölt oszlopoknál amelyikre rá tettem tehát most pl =$F$3:$F$11?"
Pontosítsunk egy kicsit: celláknál a helyes
Igen, ha az adott cella értéke megegyezik a feltétellel, akkor átszíneződik.
Feltéve, ha... A vizsgált cella tartalma tényleg dátum... Úgy látom, angol Excelt használsz, ezért a DÁTUM() függvény angol megfelelőjét kell használnod. -
Pakliman
tag
"Alakula molekula"
A következő javaslatom lett volna a keresendő/beírandó lista egy külön táblázatba, de őszintén, nem mertem ajánlani, mert túl-túl kezdőnek látszottál az előzőek alapján. Így viszont már más a felállásSub Fut()
'A főtáblára vonatkozó deklarációk:
Dim usF As Long
Dim sorF As Long
Dim elsősor As Long
'Főtábla utolsó sorának meghatározása
usF = Columns("AC").Rows(Rows.Count).End(xlUp).Row
'A keresendőket tartalmazó táblára vonatkozó deklarációk:
Dim wsK As Worksheet 'a hosszú "elnevezést" lecseréljük majd egy rövidre...
Dim usK As Long
Dim sorK As Long
'Az egyszerűség kedvéért úgy vesszük, hogy a MUNKAFÜZET már nyitva van,
'a neve Csere.xlsm, a keresendők listája a Keresendők nevű munkalapon van...
'A keresendő kifejezések az A oszlopban, a G-be írandók a B, a H-ba írandók pedig a C oszlopban vannak
'Feltételezzük, hogy az első sor fejléc...
'A keresendőket tartalmazó tábla utolsó sorának meghatározása...
Set wsK = Workbooks("Csere.xlsm").Worksheets("Keresendők")
usK = wsK.Columns("A").Rows(Rows.Count).End(xlUp).Row
elsősor = 2 'nem tudom, Nálad melyik sorban kezdődik:(
For sorF = elsősor To usF
'Csak akkor vizsgálódunk, ha a sorban a G és H oszlopban sincs még semmi...
If (Cells(sorF, "G") & Cells(sorF, "H")) = "" Then
'Feltétel(ek) vizsgálata...
'Sok feltételt vizsgálunk 1 cellában...
For sorK = 2 To usK
If Cells(sorF, "AC") Like "*" & wsK.Cells(sorK, "A") & "*" Then
Cells(sorF, "G") = wsK.Cells(sorK, "B")
Cells(sorF, "H") = wsK.Cells(sorK, "C")
'Mivel volt találat és a G és H oszlop ki van töltve,
'ezért a többi lehetőséget már nem vizsgáljuk!!
Exit For
End If
Next sorK
End If
Next sorF
End Sub -
Pakliman
tag
Szia!
Te írtad, hogy esetleg makróval is... Ezért küldtem olyan megoldást. Bár ezt a feladatot makró nélkül nem lehet elvégezni.
Azt hittem, hogy legalább alapszinten ismeredAz AC oszlop tartalmát és az alapján a G és H kitöltését ez végzi:
If feltétel = True Then
Cells(sor, "G") = "beírandó..."
Cells(sor, "H") = "beírandó..."
End If
Egy "konkrét" példa:If Cells(sor, "AC") = "cica" Then
Cells(sor, "G") = "ragadozó"
Cells(sor, "H") = "nyávog"
End IfEzt annyiszor illeszted be a kódba, ahány féle feltétel van.
DE!!!!!!!!!
Ha nem minden esetben ugyanazok a keresendő adatok vannak az AC oszlopban, hanem lehet pl. cica, macska, macsek, cirmi stb, amit ugyan annak kell "értelmezni" a keresésben, akkor már sokkal komplikáltabb a dolog.
Az sem mindegy, hogy az AC oszlopban maga a keresendő adat található (pl.: cica),
vagy a cellán belül valahol előfordul (pl.: A cica felmászott a fára. -> Ez esetben a feltételvizsgálatIf Cells(sor, "AC") Like "*cica*" Then).
Mivel nem írtál példákat az AC oszlop lehetséges tartalmára és a G, H oszlopba beírandóra sem, ezért jelenleg csak ennyit tudok segíteni
Ha ki akarod küszöbölni a manuális szűréseket, akkor fel kell kötni a gatyát és ismerkedni a VBA-val.
Ha írsz konkrétumokat, segítek -
Pakliman
tag
Ezt még ki kell bővíteni, hogy megfeleljen a feladatnak.
Nincs benne direkt szűrés, hanem minden futtatáskor végigmegy a sorokon.
(Ezt is elszúrtam, helyesen:If (Cells(sor, "G") & Cells(sor, "H")) = "" Then)
Megnézi, hogy az adott sor G és H oszlopában van-e már valami.
Ha nincs, akkor a feltételvizsgálatnak megfelelően beírja az adott sor G és H oszlopába a megfelelő értéket. -
Pakliman
tag
Szia!
Későn vettem észre a javítandót
Sub Fut()
Dim us As Long
Dim sor As Long
Dim elsősor As Long
'Utolsó sor meghatározása
us = Columns("AC").Rows(Rows.Count).End(xlUp).Row
elsősor = 2 'nem tudom, Nálad melyik sorban kezdődik:(
For sor = elsősor To us
'Ha a sorban a G és H oszlopban sincs még semmi...
If (Cells(sor, "G") & Cells(sor, "G")) = "" Then
'Feltétel vizsgálata...
If feltétel = True Then
Cells(sor, "G") = "beírandó..."
Cells(sor, "H") = "beírandó..."
End If
End If
Next sor
End Sub -
Pakliman
tag
Szia!
Egy nagyon leegyszerűsített kód, ami az elvet mutatja (egy lehetőségként):
Sub Fut()
Dim us As Long
Dim sor As Long
Dim elsősor As Long
'Utolsó sor meghatározása
us = Columns("AC").Rows(Rows.Count).Row
elsősor = 2 'nem tudom, Nálad melyik sorban kezdődik:(
For sor = elsősor To us
'Ha a sorban a G és H oszlopban sincs még semmi...
If (Cells(sor, "G") & Cells(sor, "G")) = "" Then
'Feltétel vizsgálata...
If feltétel = True Then
Cells(sor, "G") = "beírandó..."
Cells(sor, "H") = "beírandó..."
End If
End If
Next sor
End Sub -
Pakliman
tag
válasz
Fferi50
#48201
üzenetére
Köszi!
Eszembe nem jutott volna ez a megoldás
Az Offset valahogy nem a barátom, soha nem használom.
Lehet, hogy köze van ahhoz, hogy egy volt kollégám által írt program -amit a mai napig használunk- tele van vele (is):Range("a1").Select: ActiveCell.Offset(vez1(7, 1) + 3, vez1(7, 2)).Range("A1").Select
sa = ActiveCell.FormulaR1C1:
Do Until sa = ""
ActiveCell.Offset(2, 0).Range("A1").Select: sa = ActiveCell.FormulaR1C1Időnként kelleni fejleszteni/módosítani, de egy idő után már elveszítem a fonalat és inkább hagyom (sokszor nekivágtam már
).Csak a kötekedés miatt:
az Offset miatt hibára fut, ha teljes sort adunk meg, tehát egy oszlopszám figyelő beépítése szükséges.
-
Pakliman
tag
válasz
BEndre34
#48192
üzenetére
Szia!
Módosítás:
Public Function xDB(r As Range) As Long
Dim c As Range
Dim s As String
For Each c In r.Cells
s = s & IIf(IsEmpty(c), Chr(1), c.Value)
Next c
Do While InStr(1, s, "11") > 0
s = Replace(s, "11", "1")
Loop
xDB = Len(s) - Len(Replace(s, "1", ""))
End Function -
Pakliman
tag
válasz
BEndre34
#48188
üzenetére
Szia!
Egy lehetőség:
Public Function xDB(r As Range) As Long
Dim c As Range
Dim s As String
For Each c In r.Cells
s = s & IIf(s = "", "", ";") & IIf(IsEmpty(c), Chr(1), c.Value)
Next c
s = Replace(s, "1;1", "")
xDB = Len(s) - Len(Replace(s, "1", ""))
End FunctionCsak azokat az 1-eseket számolja, amelyik mellett nincs 1-es
(hiba: 3 egymás mellettit viszont már 1-nek számol!!).Ha jól értelmeztem a feladatot...
-
Pakliman
tag
válasz
andreas49
#48151
üzenetére
Szia!
Egy lehetőség:
=HA(DARABTELI($A$1:A1;A1)=1;SZUMHA(A:A;A1;B:B)/DARABTELI(A:A;A1);"")
Az első DARABTELI-nél FONTOS a $A$1:A1! Ez adja meg a dátum első előfordulását és csak ennél lesz átlag számolva. Természetesen működik e nélkül is.A sorazonosítót nem tudom igazítani. Egy megoldás van, ha az A oszlopban "lehúzod" az =SOR() függvényt majd az A oszlopra beállítod a függőlegesen középre igazítást.
-
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).pDocumentsor 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).
-
Pakliman
tag
válasz
BEndre34
#47586
üzenetére
Szia!
Megoldható úgy is: az útvonalat a
ThisWorkbook.Pathfogja megadni a makróm elején:MFName = Dir(ThisWorkbook.Path & "\Jelenléti ##.##.xlsx")De egy másik lehetőség:
A kollégák választják ki a szükséges táblázatokat (hibakezelést itt sem csináltam!).
Az összesítő munkalapra teszel egy ActiveX CommandButton-t, aminek a kódja:Private Sub CommandButton1_Click()
Dim twb As Workbook: Set twb = ThisWorkbook
Dim fd As FileDialog
Dim i As Long
Dim MFName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*"
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
If .SelectedItems(i) Like "*\Jelenléti ##.##.xls*" Then
Workbooks.Open Filename:=.SelectedItems(i)
MFName = ActiveWorkbook.Name
ActiveWorkbook.Sheets(1).Copy Before:=twb.Sheets(1)
ActiveSheet.Name = Mid(MFName, 11, 6)
Workbooks(MFName).Close SaveChanges:=False
End If
Next i
End If
End With
End Sub -
Pakliman
tag
válasz
BEndre34
#47562
üzenetére
Szia!
Egy egyszerűsített lehetőség (nincs hibakezelés):
Sub Makró1()
Dim MFName As String
MFName = Dir("x:\utvonal\Jelenléti ##.##.xlsx")
Do While MFName <> ""
Workbooks.Open Filename:="x:\utvonal\" & MFName
ActiveWorkbook.Sheets(1).Copy Before:=Workbooks("Összesítő").Sheets(1)
ActiveSheet.Name = Mid(ActiveWorkbook.Name, 11, 6)
Workbooks(MFName).Close SaveChanges:=False
MFName = Dir 'NINCS PARAMÉTER!!
Loop
End Sub -
Pakliman
tag
válasz
Dilikutya
#47070
üzenetére
Szia!
1 lehetőség...:
Private Sub Worksheet_Change(ByVal Target As Range)
'Feltételezzük, hogy az A oszlopban kezdik a beírást, a dátum pedig az X oszlopba kerül...
If Not Application.Intersect(Target, Columns(1)) Is Nothing Then
Application.EnableEvents = False
'Ha van "zárolt" cella, akkor van bekapcsolt védelem is a munkalapra...
ActiveSheet.Unprotect "jelszo"
Cells(Target.Row, "X") = Date
ActiveSheet.Protect "jelszo"
Application.EnableEvents = True
End If
End Sub -
Pakliman
tag
válasz
andreas49
#46956
üzenetére
Szia!
Egy lehetőség...
Az sPath mappában lévő összes *.xls* fájlon végigmegy.
Megnyitja a fájlt, a benne lévő munkalapokon megkeresi és kicseréli az összes sMit (cserélendő) szöveget az sMire szövegre majd bezárja MENTÉSSEL a megnyitott táblázatot.Sub x()
Const sPath As String = "d:\_Egyéb\"
Dim sName As String
Dim sFullName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim sAddr1 As String
Dim sMit As String
Dim sMire As String
sMit = "keresendő szöveg"
sMire = "erre cseréljük"
sName = Dir(sPath & "*.xls*")
Do Until sName = ""
sFullName = sPath & sName
Set wb = Workbooks.Open(Filename:=sFullName)
For Each ws In wb.Worksheets
With ws.Cells
Set r = .Find(What:=sMit, LookIn:=xlValues, LookAt:=xlPart)
If Not r Is Nothing Then
sAddr1 = r.Address
Do
r.Value = Replace(r.Value, sMit, sMire)
Set r = .FindNext(r)
Loop While Not r Is Nothing
End If
End With
Next ws
wb.Close SaveChanges:=True
sName = Dir
Loop
End Sub -
Pakliman
tag
válasz
PistiSan
#46904
üzenetére
Szia!
Egy lehetőség:
Sub Kitölt()
Dim us As Long
Dim sor As Long
Dim s As String
us = Cells(Rows.Count, 2).End(xlUp).Row
For sor = 1 To us
'végig megyünk a sorokon...
If Cells(sor, 1) <> "" Then
'Ha az 1. oszlopban van szöveg,...
'akkor eltároljuk...
s = Cells(sor, 1)
Cells(sor, 1) = "TÖRLENDŐ" 'Csak a későbbi egyszerűbb azonosítás miatt...
Else
'ha nincs szöveg, akkor...
'ha 2. oszlopban van szöveg, akkor az . oszlopba beírjuk az elmentett szöveget
If Cells(sor, 2) <> "" Then Cells(sor, 1) = s
End If
Next sor
'Most jön az Extra, a fölösleges sorok törlése...
For sor = us To 1 Step -1
If Cells(sor, 1) = "TÖRLENDŐ" Then Rows(sor).EntireRow.Delete
Next sor
End Sub -
Pakliman
tag
válasz
zsolti_20
#46768
üzenetére
Szia!
A csatolt kép alapján (feltételezve, hogy azon nincs semmilyen formázás!) az egy számokból álló szöveg (mivel a cella bal oldalán van).
A vessző az az angol területi beállítás szerinti ezres elválasztó. Pontra cserélni csak úgy tudod, ha elosztod 1000-el vagy szövegként kezeled és BAL/JOBB függvényekkel "kettévágod" és középre teszel egy pontot.
Pl.: =IF(A1 <> "",AJ5/1000,"") vagy =IF(A1 <> "",LEFT(AJ5,3) & "." & RIGHT(AJ5,3),"") -
Pakliman
tag
válasz
MostaPista
#46764
üzenetére
Szia!
A fájlrendszeren a formatáláskor létrejönnek a meghatározott méretű "tárhelyek" (az oprendszer ezek címére tud hivatkozni íráskor/olvasáskor), Mindegyikhez kizárólag "1 darab fájlnév társulhat".
A felső sorban látható, hogy a szektorméretnél kisebb méretű fájlok mekkora helyet pocsékolnak el!
Még a legkisebb (a képen 200 Bájtos) fájl is elfoglal (jelen esetben) 4096 Bájltnyi helyet!
Az alsó sorban sokkal kevesebb a veszteség.
Ezért nincs értelme számolgatnod. -
Pakliman
tag
válasz
Norbika1493
#46735
üzenetére
Szia!
Pl. az összefoglaló utolsó sora...
-
Pakliman
tag
válasz
Dilikutya
#46704
üzenetére
Nem igazán értem, hogy ez miért lenne jó Neked, de ha ettől függ a világbéke, akkor a munkalap Worksheet_Change eseményébe kell megírni a kódot, valami ilyesmit, hogy:
ha ez a cella (Target!) változik
ha nem üres (most írtál bele valamit) akkor abba a cellába beírjuk a képletet
ha üres (most törölted az értékét) akkor abból a cellából töröljük a képletet -
Pakliman
tag
válasz
the radish
#46659
üzenetére
Szia!
Egy kis módosítás kell:
Dim wb As WorkbookIf sFile <> "" Then
Set wb = Workbooks.Open(sFile) ' Open the Excel file.
'...
'Másolás a wb.Worksheets("munkalapnév").cells(sor,oszlop)....
'Végül:wb.Close SaveChanges:=FalseEnd If -
Pakliman
tag
Ha előre tudod, hogy melyik mappákban kell keresni, akkor kis bővítéssel működik.
Csak annyiszor kell a programkódot lemásolni a megfelelő mappanévvel, ahány mappában keresni akarsz.
Ezt csak néhány mappa esetén célszerű használni.
Természetesen a mappaneveket tömbbe is rakhatod, majd egy For..Next ciklussal végig mész rajtuk.
Így sokkal rövidebb (és elegánsabb) lesz a kód.Sub xx()
Dim aMappa
Dim sMappa As String
Dim s As String
Dim wb As Workbook
Dim i As Long
aMappa = Array( _
"C:\Dokumentumok\___TEMP\", _
"c:\Dokumentumok\Run\", _
"c:\Dokumentumok\_ VEGYES\_Downloads\" _
)
For i = LBound(aMappa) To UBound(aMappa)
sMappa = aMappa(i)
s = Dir(sMappa & "*.xls*")
Do While s <> ""
Set wb = Workbooks.Open(sMappa & s)
If IsEmpty(wb.Worksheets("Ellenőrzendő").Range("B25")) Then
wb.Worksheets("Ellenőrzendő").Range("B25") = "Készítő neve"
wb.Save
End If
wb.Close
s = Dir
Loop
Next i
End SubVáltozó mappastruktúra esetén már előkerül a rekurzív könyvtárkezelés.
Az már egy kicsit bonyolultabb dolog. -
Pakliman
tag
Sub xx()
Dim sMappa As String
Dim s As String
Dim wb As Workbook
sMappa = "C:\Dokumentumok\___TEMP\"
s = Dir(sMappa & "*.xls*")
Do While s <> ""
Set wb = Workbooks.Open(sMappa & s)
If IsEmpty(wb.Worksheets("Ellenőrzendő").Range("B25")) Then
wb.Worksheets("Ellenőrzendő").Range("B25") = "Készítő neve"
wb.Save
End If
wb.Close
s = Dir
Loop
End Sub -
Pakliman
tag
Sub btRogzit_Click()
Dim sor As Long
Dim lMax As Long
Dim l As Long
Dim emptyRow As Long
Munka2.Activate
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
For sor = 1 To emptyRow - 1
If Cells(sor, 1) Like "KSZ-#*" Then
l = Mid(Cells(sor, 1), 5)
If l > lMax Then lMax = l
End If
Next sor
Cells(emptyRow, 1).Value = "KSZ-" & lMax + 1 'tbSorszam.Value -> többé nem kell:)
Cells(emptyRow, 2).Value = tbElado.Value
Cells(emptyRow, 3).Value = tbBrutto.Value
Cells(emptyRow, 5).Value = cbEv.Value & "/" & cbHonap.Value & "/" & cbNap.Value
Unload Me
End Sub -
Pakliman
tag
válasz
logitechh
#46565
üzenetére
Szia!
Mindkét exportos eljárásban az éppen aktív MUNKAFÜZETET NEVEZED ÁT (ActiveWorkbook.SaveAs)!
Mellékszál:
Sokszor hajtatod végre vele ugyanazokat a műveleteket.
Ezeket kiküszöbölheted egy egyszeri értékadással:sNewNamePart1 = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_"A cntr használatának nem látom semmiféle értelmét, hiszen a fájlnévben nem sorszámozást vagy darabszámot használsz, hanem pontos időt (persze lehet ebből is több, ha másodpercenként többször is lefut a program!!)
Ez egy lehetőség (ha kell, át tudod alakítani xls exportra is):
Sub ActiveSheetExportToTXT()
Dim sNewName As String 'A létrehozandó fájl neve
Dim sSheetName As String 'A mentendő munkalap neve
Dim sSheetFIX As String 'A FIX cellát tartalmazó munkalap neve
'Névnek a munkalap nevét és egy FIX cellából vett értéket szeretném plusz az aktuális dátum időpont másodpercre pontosan.
sSheetFIX = "A FIX cellát tartalmazó munkalap neve"
sSheetName = "A mentendő Munkalap neve"
sNewName = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & Worksheets(sSheetFIX).Range("FIX cella") & "_" & Format(Now, "yyyymmdd_hhnn_ss") & ".txt"
Worksheets(sSheetName).Copy
ActiveWorkbook.SaveAs Filename:=sNewName, FileFormat:=xlText, CreateBackup:=False
End Sub -
Pakliman
tag
Szia!
A
' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
HtmlFont = HtmlFont = "<body font: " & 11 & "pt " & Arial & ";color:black"">"
kód (jelen esetben) hibás.A HtmlFont értéke FALSE lesz, mivel feltételt vizsgáltatsz vele...
Helyesen:
HtmlFont = "<body font: " & 11 & "pt " & Arial & ";color:black"">" -
Pakliman
tag
Szia!
Az egy nagyon-nagyon fa, amibe a fejszédet akarod vágni...
Megoldható a dolog, csak sokat kell olvasni, tanulni ésszentségyakorolni
Javaslom áttanulmányozni ezt és ezt. A utóbbival találkoztam hamarabb, abból tanultam meg néhány olyan dolgot, amire nekem szükségem volt. A látszat ellenére egyértelmű, hogy mi mit csinál. Ne ijedj meg tőle -
Pakliman
tag
Ebben a sorban
Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)
azAccount-nak egy számnak kell lennie (fentebb deklarálva van konstansként 2-nek).
Szerintem azért fut hibára Neked, mert a 2 az túl nagy szám neki, nincs a rendszerben olyan sorszámúAccount.
Ha megint megáll hibával azon a ponton, akkor írd be az "Immediate" ablakba:? OutlApp.Session.Accounts.Count
Ha 2-nél kisebb számot ad eredménynek, akkor megvan a hiba. -
Pakliman
tag
Igen, arra rájöttem, hogy el is akarod küldeni, csak a PDF készítésnek és a küldésnek nincs köze egymáshoz.
Mondjuk úgy, hogy kicsit kötözködtem VeledÉn céges gépen vagyok, automatikusan küldök ki címekre automatikusan generált pdf fájlokat, de ilyen hibával nem találkoztam.
Tény, hogy nálam nincs a kódbanAccount-ot kérő sor.
Ha érdekel, én egy ilyen eljárást hoztam össze:Public Sub SendEmail( _
xTo As String, _
xSubject As String, _
Optional xCC As String = "", _
Optional xBCC As String = "", _
Optional xBody As String = "", _
Optional xHTMLBody As Variant = "", _
Optional bSend As Boolean = False, _
Optional bTörölniKüldésUtán As Boolean = False, _
Optional vFiles As Variant = Empty _
)
Const olFolderSentMail As Long = 5
Const olByValue As Long = 1
Dim OutApp As Object
Dim OutMail As Object
Dim oFolder As Object
Dim oEditor As Object
Dim cFile As Long
Dim sBody As String
If (xTo <> "") And (xSubject <> "") Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = xTo
.cc = xCC
.BCC = xBCC
.Subject = xSubject
If TypeName(xHTMLBody) = "Range" Then
xHTMLBody.Copy
Set oEditor = .GetInspector.WordEditor
oEditor.Content.Paste
Else
sBody = IIf(xHTMLBody = "", xBody, xHTMLBody): If sBody = "" Then sBody = " "
.HTMLBody = sBody
End If
If IsArray(vFiles) Then
For cFile = LBound(vFiles) To UBound(vFiles)
If Dir(vFiles(cFile)) <> "" Then .Attachments.Add (vFiles(cFile)) 'Source:=vFiles(cFile), Type:=olByValue
Next cFile
Else
If Dir(vFiles) <> "" Then .Attachments.Add (vFiles) 'Source:=vFiles, Type:=olByValue
End If
If bSend Then
.DeleteAfterSubmit = bTörölniKüldésUtán
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
End Sub -
-
Pakliman
tag
válasz
pero19910606
#46236
üzenetére
Szia!
Az X1-nek nem adsz értéket sehol!
EzIf x1 = ((a * b) - (c + d)) > 0 Thennem értékadás, hanem egy "egyszerű" feltételvizsgálat. -
Pakliman
tag
válasz
woodworm
#46169
üzenetére
A különböző munkafüzetekben található információt össze tudod hozni egy munkalapra (feltéve, hogy van mivel létrehozni a kapcsolatot pl. FKERES-sel).
Ha ez megvan, akkor a Word körlevélhez már csak ezt az egy munkafüzetet kell hozzárendelni, aztán mehet a szűrés...
Évek óta használom ezt a technikát, kb 800 ember adatai különböző táblázatokból.
Mindenkinek van egy egyedi (céges) azonosítója, ami minden táblázatban szerepel, ezzel jön létre a kapcsolat. -
Pakliman
tag
válasz
ZoltanRobi
#45915
üzenetére
-
Pakliman
tag
-
Pakliman
tag
válasz
ZoltanRobi
#45746
üzenetére
Szívesen
-
Pakliman
tag
válasz
ZoltanRobi
#45736
üzenetére
Szia!
Készítettem egy példa munkafüzetet...
Ez Google Drive-os (amíg a DATA vírust keres...)
Itt nem használtam makrót (pedig lehet, hogy úgy egyszerűbb lenne), se tömbképletet (már nézegettem, de nekem az még magas...).A lényeg, hogy meg kell határoznod egy maximális kölcsönbe adási hónap számot (jelenleg 3 hónapnyi intervallumot tud kezelni) és annak megfelelően kell bővíteni jobbra a táblázatot (elméletileg az N
oszlopcsoport simán másolható tovább).
Az Összesítés munkalapon is ki kell egészíteni annak megfelelően a képletet.
A hivatkozásokban szerepelnek $ jelek, ezek fontosak!!Ha havonta változik a napidíj (miért ne változhatna), az is belefűzhető, de most még nem kezeli!
További kellemeset...
-
Pakliman
tag
-
Pakliman
tag
válasz
hódmaci
#45662
üzenetére
Szia!
Munkalaponként:
- kijelölöd az összes figyelendő cellát
- Képletek menü -> Név megadása -> beírsz egy nevet"Összegző" munkalapon a képlet:
=DARAB2(Tartomány1)+DARAB2(Tartomány2)
Ez a tartományban lévő "nem üres(!!)" cellákat szamolja meg.A darabteli függvény jobb lenne (megadhatnád neki, hogy csak az x-eket, vagy csak a 2-t tartalmazó cellákat összesítse), de az sajnos hibára fut, ha a tartomány nem egymás melletti cellákból áll
-
Pakliman
tag
válasz
Lokids
#45540
üzenetére
Szia!
Private Sub Kód_írása_programból()
Dim c As Long
'Új munkafüzet létrehozása
Workbooks.Add
c = Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
'Az új munkafüzetbe beírunk egy kódot!!!
With Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines c + 1, "'Ezeket a sorokat programból hoztuk létre!!"
.InsertLines c + 2, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
.InsertLines c + 4, "End Sub"
End With
End SubItt egy részletes és "teljesen érthető" leírás.
Én is ebből (is) tanulgattam. -
Pakliman
tag
válasz
Norbika1493
#45186
üzenetére
Egy pl...
Ez egy meglévő táblázatban halad végig és bizonyos cellák értéke alapján színez bizonyos számokat is.
Készít egy táblázatot az így létrejótt listából és elküldi a megadott címzetteknek:Public Enum OlBodyFormat
olFormatUnspecified = 0
olFormatPlain = 1
olFormatHTML = 2
olFormatRichText = 3
End Enum
Private Function TableDataColor(strIn As String, Optional color As String = "") As String
If color = "" Then
TableDataColor = strIn
Else
TableDataColor = "<FONT COLOR=" & color & ">" & strIn & "</FONT>"
End If
End Function
Private Function Table(strIn As String, Optional lBorder As Long = 0) As String
Dim sBorder As String
If lBorder = 0 Then
sBorder = ""
Else
sBorder = " border=" & lBorder
End If
Table = "<TABLE" & sBorder & ">" & strIn & "</TABLE>"
End Function
Private Function TableData(strIn As String, Optional alignment As String = "") As String
TableData = "<TD nowrap align=" & alignment & ">" & strIn & "</TD>"
End Function
Private Function TableRow(strIn As String) As String
TableRow = "<TR>" & strIn & "</TR>"
End Function
Public Sub Email_Humányügyre()
Dim sSzöveg1 As String: sSzöveg1 = "Kedves Lányok!" & "<br /><br />"
Dim sSzöveg2 As String: sSzöveg2 = "Szíves hasznosításra..." & "<br /><br />" & _
"Üdv," & "<br /><br />"
Dim OutApp As Object
Dim OutMail As Object
Dim strFej As String
Dim strTB As String
Dim sDátum As String: sDátum = Format(Format(Range("Z1"), "0000"".""00"".""00"), "yyyy. mmmm")
Dim sTárgy As String: sTárgy = "Külsősök teljesítései " & sDátum
Dim lAktSor As Long
Dim lÚjSor As Long
Dim szín As String
strFej = TableRow( _
TableData("HR") & _
TableData("Név") & _
TableData("Összes óra") _
)
For lAktSor = 3 To Cells.Rows.Count 'Az utolsó sort célszerű először meghatározni...
If IsEmpty(Cells(lAktSor, 1)) Then Exit For
If Cells(lAktSor, 15) = "Külsős" Then
Select Case Cells(lAktSor, 11)
Case 60 To 79.9
szín = "blue"
Case Is > 80
szín = "red"
Case Else
szín = ""
End Select
strTB = strTB & _
TableRow( _
TableData(Cells(lAktSor, 1)) & _
TableData(Cells(lAktSor, 2)) & _
TableData( _
TableDataColor( _
Format(Cells(lAktSor, 11), "0.0"), _
szín _
), _
"right" _
) _
)
End If
Next lAktSor
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Humánügyek"
.CC = "hum1@hum.hu; hum2@hum.hu"
.BCC = ""
.Subject = sTárgy
.BodyFormat = 2 'olFormatHTML
.HTMLBody = sSzöveg1 & _
Table( _
"<Caption>Külsős órák</Caption>" & _
strFej & _
strTB _
, 1) & "<br /><br />" & _
sSzöveg2
.Display ' vagy elküldéshez .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub -
Pakliman
tag
Szia!
Egy kis makrózással megoldható...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = Range("A1").Address Then
'Duplaklikk az A1 cellán
Cancel = True 'Megakadályozzuk, hogy szerkesztő módba lépjen a cellában.
Dim sha As Worksheet: Set sha = Worksheets("Munka1") 'ActiveSheet
Dim shk As Worksheet: Set shk = Worksheets("Munka2")
Dim usa As Long: usa = sha.Cells(sha.Rows.Count, "A").End(xlUp).Row 'A Munka1 utolsó sora
Dim usk As Long: usk = shk.Cells(shk.Rows.Count, "A").End(xlUp).Row 'A Munka2 utolsó sora
Dim sora As Long
Dim sork As Long
'Nem kell folyton újraszámolni, sem villogtatni a képet...
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Kiürítjük a B oszlopot...
sha.Range("B2:B" & usa).ClearContents
For sora = 2 To usa
For sork = 2 To usk
If sha.Cells(sora, 1) Like shk.Cells(sork, 1) & "*" Then
'Ha a Munka1 aktuális cellája "hasonlít" a Munka2 aktuális cellájára, akkor...
sha.Cells(sora, 2) = 1 '...a Munka2 2. oszlopába berakunk egy 1-est
Exit For 'Mivel van találat, a több elemet már nem vizsgáljuk, továbblépünk...
End If
Next sork
Next sora
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub -
Pakliman
tag
válasz
tomi_x
#44145
üzenetére
Az A oszlop tartalmazza az "azonosítót", az E oszlopba kell rakni a képletet.
A képen a D oszlop tartalmazza az értéket, amit összesíteni akarsz.
Ha a tényleges táblázatban ez a bizonyos D (vagyis az érték) nem szerepel, akkor hozd létre, mint segédoszlop és a képletben arra az oszlopra hivatkozz. -
Pakliman
tag
válasz
ROBOTER
#43257
üzenetére
Szia!
Kipróbáltam a kódodat, de nálam minden esetben (többszöri indítás és beírás) kiírta a jobb oldalra $B$11-et.
Valahol kell lennie egy utasításnak a kódodban, ahol aWorksheets("START").Range(newSheetNamePos)cella értéke törlésre kerül (akár delete, akár szóköz, akár ""). -
Pakliman
tag
válasz
ROBOTER
#43220
üzenetére
Szia!
Ez alapján elindulhatsz:
Private Sub Kód_írása_programból()
Dim c As Long
'Új munkafüzet létrehozása
Workbooks.Add
c = Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
'Az új munkafüzetbe beírunk egy kódot!!!
With Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines c + 1, "'Ezeket a sorokat programból hoztuk létre!!"
.InsertLines c + 2, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
.InsertLines c + 4, "End Sub"
End With
End SubAz idézőjelekre kell nagyon odafigyelni, amikor "szöveggé" alakítod a létrehozott programkód sorait:
sKód = ""
sKód = sKód & vbLf & "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)"
sKód = sKód & vbLf & " Dim TaláltSor"
sKód = sKód & vbLf & " Dim sCrit As String"
sKód = sKód & vbLf & " Dim sÉvHó As String"
sKód = sKód & vbLf & " Dim c"
sKód = sKód & vbLf & ""
sKód = sKód & vbLf & " If Cells(1, Target(1).Column) = ""Név"" Then"
sKód = sKód & vbLf & " Cancel = True"
sKód = sKód & vbLf & " TaláltSor = Application.Match(Cells(ActiveCell.Row, 4), Columns(4), 0)"
sKód = sKód & vbLf & " If Not IsError(TaláltSor) Then"
sKód = sKód & vbLf & " ActiveWindow.ScrollRow = TaláltSor"
sKód = sKód & vbLf & " Cells(TaláltSor, ActiveCell.Column).Activate"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " Else"
sKód = sKód & vbLf & " If Target(1).Row = 1 Then"
sKód = sKód & vbLf & " For Each c In Range(""A:A"")"
sKód = sKód & vbLf & " If c.Value Like ""T*2#######"" Then"
sKód = sKód & vbLf & " sÉvHó = Left(Right(c, 8), 6)"
sKód = sKód & vbLf & " sÉvHó = Left(sÉvHó, 4) - 1 & Right(sÉvHó, 2)"
sKód = sKód & vbLf & " Exit For"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " Next c"
sKód = sKód & vbLf & " If sÉvHó <> """" Then"
sKód = sKód & vbLf & " Cancel = True"
sKód = sKód & vbLf & " sCrit = "">="" & sÉvHó"
sKód = sKód & vbLf & " Cells.AutoFilter Field:=Target(1).Column, Criteria1:=sCrit, Operator:=xlAnd"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & "End Sub"
.AddFromString sKód -
Pakliman
tag
válasz
Zola007
#43075
üzenetére
Szia!
Először is kell egy másolat az "eredeti" kiválasztható értékekről. Célszerű az eredeti lista mellett létrehozni. Ezt el is rejtheted.
A listaelem átírásakor az alábbiakat kell tenni a makróban (Worksheet_Change):
- Letiltod az eseménykezelőt: Application.Enabelevents=False
- a Target objektum tartalmazza az átírt elem sorának számát (Target.Row), ez lesz majd használva
- megkeresed az EREDETI szöveget a "másolatban" ( Cells(Target.Row, a_másolat_oszlopa) )
- sorra veszed a munkafüzet munkalapjait (For Each ws In Worksheets), ha kell szűrést is berakhatsz, vigyázz,
hogy az aktuális (a listát tartalmazó) munkalapot teljesen külön kezeld!
- a munkalapon megkeresed az EREDETI szöveget és átírod az újra.
- végül a listát tartalmazó munkalapon az EREDETI szöveget is átírod
- Engedélyezed az eseménykezelőt: Application.Enabelevents=True -
Pakliman
tag
válasz
Zsolt_16
#43026
üzenetére
Szia!
Az alábbi makrót nagyon régen hoztam létre, mert különbüző dolgokat más-más nyomtatóra kellett küldenem
Az "előkészületekhez" lásd Fferi50 válaszát:Public Function Nyomtató_Váltás(mire As String) As Boolean
Dim sorszám As Long
Dim Hiba As Boolean
Err.Clear
Hiba = True
On Error Resume Next
For sorszám = 0 To 99
Application.ActivePrinter = mire & " a(z) Ne" & Format(sorszám, "00") & ": kimeneten"
'A "mire" a nyomtató neve, az utána lévőt változtasd meg úgy, hogy
'egyezzen a rendszer által visszaadott "mintával"
'Nálam az Application.ActivePrinter ezt adja: "szv222 a(z) Ne07: kimeneten"
'Nem mindig Ne07, ezért kell "megkeresni" a jó portszámot.
If Err.Number = 0 Then
Hiba = False
Exit For
End If
Next sorszám
Nyomtató_Váltás = Hiba
Err.Clear
End Function
'Használata (pl.):
If Nyomtató_Váltás("szv222") Then
'...
'....amit szeretnél még elvégezni nyomtatás előtt...
ActiveSheet.PrintOut
Else
MsgBox "Nincs ilyen nyomtató!!"
End If -
Pakliman
tag
válasz
zsolti_20
#42658
üzenetére
Addig is az A és/vagy B ismétlődéseire gyógyír:
Csak a C oszlop változott (most):=HA(DARABTELI($A$2:A2;A2)=1;HA(DARABTELI(B:B;A2)>0;1;0);0)
A képlet első része (első HA(DARABTELI(...)):
az A oszlopban csak azokkal foglalkozunk, amelyik számból csak 1 db van illetve azokkal, melyekből több
van, DE CSAK AZ ELSŐ előfordulásnál!Második HA(DARABTELI(...):
a B oszlopban nem érdekel hánydarab van egy számból, ha nem 0, akkor mindenképpen 1.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
).
).
Új hozzászólás Aktív témák
- GYÖNYÖRŰ iPhone 12 Mini 64GB Black-1 ÉV GARANCIA - Kártyafüggetlen, MS3456
- GYÖNYÖRŰ iPhone 13 256GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3427, 100% Akkumulátor
- Xiaomi Redmi Note 12 Pro 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Fém, összecsukható és kihúzható fotó állvány eladó
- BESZÁMÍTÁS! ASUS H510M i5 10400F 16GB DDR4 512GB SSD RTX 2080 Super 8GB Zalman T4 PLUS FSP 700W
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest