- gban: Ingyen kellene, de tegnapra
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- vrob: Az IBM PC és a játékok a 80-as években
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- zebra_hun: Hűthető e kulturáltan a Raptor Lake léghűtővel a kánikulában?
- Magga: PLEX: multimédia az egész lakásban
- Gurulunk, WAZE?!
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
-
LOGOUT
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
-
poffsoft
veterán
válasz
poffsoft
#37556
üzenetére
Nos, eddig jutottam.
Az utolsó sor kijelölése már nem sikerül, így a selection miatt rossz területen változik a stílus.
Valaki?
Public Sub masol()
Dim WSheets As Integer, WS1 As Worksheet, WS2 As Worksheet
Dim b As Range
Dim usor As Long, sor As Long, oszlop As Integer
Dim myPath As String
Dim folderPath As String
Dim MyText As String
Dim MyRange As Object
Dim myWRange As Object
Set Wordapp = CreateObject("word.Application")
For WSheets = 1 To 1 'Worksheets.Count
Set WS1 = Sheets(WSheets)
folderPath = Application.ActiveWorkbook.Path
usor = Range("A" & Rows.Count).End(xlUp).Row + 1
With Wordapp
.documents.Open folderPath & "\temp.docx"
a = .documents.Count
.documents(a).SaveAs Filename:=folderPath & "\" & WS1.Name & ".docx" ', FileFormat:=wdFormatDocumentDefault
.Visible = True
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
MyText = WS1.Range("A1")
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_M")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
MyText = "C. Témacsoportok az üzem-specifikus kérdésekhez"
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_0")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
For oszlop = 3 To 31
For sor = 6 To 8
MyText = WS1.Cells(sor, oszlop)
If MyText <> "" Then
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_" & sor - 5)
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
End If
Next sor
For sor = 10 To usor
If WS1.Cells(sor, oszlop) <> "" Then
.documents(a).Range.InsertAfter (WS1.Cells(sor, 1))
.Selection.Style = .documents(a).Styles("List_norm")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
End If
Next sor
Next oszlop
MyRange.Selection.Collapse Direction:=wdCollapseend
.documents(a).Range.InsertparagraphAfter
End With
Wordapp.documents(a).Close
Next WSheets
Wordapp.Quit
End Sub -
n1nja
tag
válasz
poffsoft
#36040
üzenetére
akár
(gépenként az első dátumot kimenti egy tömb-be, majd a tömböt növekvő sorrendbe rendezi és az időpont új sorszámát beírja gépenként a sorting no. oszlopba)
nem szép, de működik
Private Sub CommandButton1_Click()
Dim currv As Integer
Dim csere As Date
Dim i, j, k, rowcount As Integer
Dim currmachine As String
Dim tomb(1 To 145) As Date
range("R2").Value = "Sorting no."
mint = range("C3").Value
maxt = range("C3").Value
currmachine = " "
rowcount = range("A3", range("A3").End(xlDown)).Rows.Count
Cells(3, 25).Value = rowcount
j = 0
For i = 1 To rowcount
If currmachine <> Cells(i + 2, 1) Then
currmachine = Cells(i + 2, 1)
j = j + 1
tomb(j) = Cells(i + 2, 3)
End If
Next i
For i = 1 To j - 1
For k = i + 1 To j
If tomb(i) > tomb(k) Then
csere = tomb(i)
tomb(i) = tomb(k)
tomb(k) = csere
End If
Next k
Next i
currmachine = " "
For i = 1 To rowcount
If currmachine <> Cells(i + 2, 1) Then
For k = 1 To j
If Cells(i + 2, 3) = tomb(k) Then
currv = k
End If
Next k
End If
Cells(i + 2, 18).Value = currv
Next i
End Sub -
#35403
Juditta_56
aktív tag
poffsoft
#35399
Juditta_56
aktív tag
válasz
poffsoft
#35399
üzenetére
Nagyon szépen köszönöm Neked is a segítséget!
Először a Te javaslataidat próbáltam ki:
A variant/integer különbséget nem találtam, sztem mindegyik integer:
Dim EllSor, EllOszl, JelSor, HibaOszl As Integer
Dim OsszSor, OsszOszl, OsszOszlMax As IntegerIgen, van Sheets(1) mindkét munkafüzetben, ezt már ellenőriztem - adott lapon: =LAP() -, de azért most változóba raktam mindkét lapnevet (LapNeve és ElsoLap), és átírtam őket.
A Range hivatkozásait vagy hatszor ellenőriztem, jók, a cellákban, ahonnan a változók az értékeiket veszik, abszolút hivatkozás van az oszlopokra-sorokra, hogy ha kell, akkor be lehessen szúrni oszlopokat-sorokat.
Sajnos, így sem működött, ugyanott, ugyanazt a hibát dobta.
Viszont Delila megoldása tökéletes! Újra, és gondolom, nem utoljára, nagyon szépen köszönöm!
("Természetesen", Delila, az első válaszod után a másik három copy-paste blokkban nem az egész sort, csak a végét (PasteSpecial xlPasteValues) javítottam, mert a lényeget nem vettem észre!
) -
-
PeLa87
aktív tag
-
logitechh
csendes tag
válasz
poffsoft
#35040
üzenetére
Picit finomítani kellett mert az A oszlopban és az F:L tartományban egyel túlfutott a másolás
Köszi mindenkinek
felteszem a kódot hátha valaki más is hasznát vesziSub beillesztes()
'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az F oszloptól az L oszlopig az F2:L2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("F2:L2").Copy Destination:=Range("F" & Asor & ":F" & Bsor - 1) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig
For i = Asor To Bsor - 1 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("A" & i) = Range("A" & i - 1) + 1
Next i
'innen kezdődik a keretezés
Range("A1").CurrentRegion.Select 'CTRL+a kijelöli a teljes táblázatot
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Bár nam biztos hogy szabad ennyi mindent összefűzni de szerintem így tökéletes -
logitechh
csendes tag
válasz
poffsoft
#35032
üzenetére
Kösszi neked is és Dellila_1-nek is(az övére nem tudok válaszolni mert azt írja ki,hogy várjak türelemmel amíg valaki válaszol a hozzászólásomra)
úgy látom két részre kell szednem a beillesztést és a sorszámozást mert valamiért mindig csak egyel növeli a sorszámot függetlenül hogy hány sornyi adatot illesztek be.Ez mind a kettőtök makrójánál fent áll.
De baromira megkönnyítettétek a munkám. -
poffsoft
veterán
válasz
poffsoft
#35032
üzenetére
Vagy egyszerűbben:
Sub iranyitott_beillesztes()
'
' iranyitott_beillesztes_ Makró
'
'
Dim usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row +1
Cells(usor, 1)=Cells(usor-1, 1)+1
Cells(usor, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(2, 1), Cells(usor, 12)).Select
'
' itt jöhet a szegélyezés
'
Cells(usor, 1).Select
End Sub -
logitechh
csendes tag
válasz
poffsoft
#35028
üzenetére
Hali
ebből semmit nem vágok
Sub iranyitott_beillesztes()
'
' iranyitott_beillesztes_ Makró
''
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Subebben a történetben hol szerepel a te általad leírt dolog
Rengeteg makrót találtam ami megadj az utolsó sor számát de azt nem tudom elérni hogy a B oszlop utolsó üre sorába áljon a kurzor vagyis hogy onnan kezdődjön a beillesztés -
Fferi50
Topikgazda
válasz
poffsoft
#34062
üzenetére
Szia!
Ehelyett:
If usor > 1 Then
Range(i & "2:" & i & usor).Select
Application.CutCopyMode = False
Selection.Copy
Range("H" & sm).Select
ActiveSheet.Paste
sm = sm + usor - 1
End If
Szerintem inkább így:If usor > 1 Then
Range(i & "2:" & i & usor).Copy Destination:=Range("H" & sm)
sm = sm + usor - 1
End IfSelectet kerülni érdemes, ahol csak lehet.
Üdv.
-
Fferi50
Topikgazda
válasz
poffsoft
#33962
üzenetére
Szia!
Egyetértek, mert így csak egy cellát kell állítani, de azt meg kell előtte vizsgálni, hogy valóban a listát tartalmazó cellát szerkesztette-e. Ezért van a feltételsor.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Range("A1"), Range("K1"))) Is Nothing Then
'ide sorold fel az Union függvényen belül azokat a cellákat, ahol listád lesz.
Sheets("Munka1").Rows(Target.Row).AutoFit
Sheets("Munka2").Rows(Target.Row).AutoFit
'és így tovább
End If
End SubÜdv.
-
nordican
tag
válasz
poffsoft
#33896
üzenetére
Köszi, ez az! Szerinted olyat bele lehet építeni, hogy az éppen aktív vagy a kijelölt munkalapokon végezze el a cserét? Próbáltam az ActiveSheet-tel, de ezzel nem működik.
Sub Makro1()
Dim list() As String
Dim liste As String
Dim i As Integer
Dim c As Range
Dim rng As Rangeliste = "ActiveSheet" 'a munkalapok nevei, ahol keresni kell, vesszővel elválasztva
list() = Split(liste, ",")
For i = 0 To UBound(list)
Set rng = Sheets(list(i)).Range("A1
100")
For Each c In rng
With c.Interior
If .ColorIndex = 6 Then
.ColorIndex = None
.Pattern = xlNone
End If
End With
Next c
Next i
End Sub -
-
Fferi50
Topikgazda
válasz
poffsoft
#33813
üzenetére
Szia!
Akkor két malomban őröltünk, mert a Cell("filenév") úgy adja vissza a nevet, hogy a fájlnév ott van a teljes elérési út végén, így valóban az azt megelőző rész a mappa.
Az Excel VBA által visszaadott Path és Curdir() viszont elválasztójel nélkül adja az elérési utat.Úgyhogy mindkettőnknek igaza van.
Üdv.
-
Fferi50
Topikgazda
válasz
poffsoft
#33810
üzenetére
Szia!
Bocs, de nekem pont az volt a tapasztalatom, hogy a tömb utolsó értékét nem adta vissza az eredeti formájában a függvény. Volt egy háromtagú bemenő paraméterem, ha úgy hívtam meg, hogy n=3, akkor #SOK-kal kiszállt és nem adta a 3. tagot
A módosítás után pedig igen. Az n-1 csak a következő sor Else ágán van.
A num értéke 3 tagú elemnél ugye 2. Ezért kell abban a sorban is n-1 a hasonlításban.If num < n Then STR_SPLIT = "#SOK": Exit Function 'Itt leáll, ha az utolsó tagot szeretnéd megkapni
If n = 0 Then STR_SPLIT = num Else STR_SPLIT = V(n - 1) 'és már nem jut el ide.Pl. =STR_SPLIT("Alma,Körte,Kalács";",";3) eredménye #SOK, ha az n=2, akkor pedig Körte
Kalács sehogyan sem akart kijönni. Ezért kell num<n-1 az első hasonlításba.
(Még annyit, ha már ilyen mélyen belementünk, hogy én n=0 meghíváskor num+1 értékét írnám ki, mert ennyi tag szerepel a beadott tömbben. A num az elválasztójelek számát adja meg gyakorlatilag.)Üdv.
-
Fferi50
Topikgazda
-
Fferi50
Topikgazda
válasz
poffsoft
#33797
üzenetére
Szia!
Szép-szép. Csak azt nem értem, miért kell a cella függvényt is belekeverni, ha már egyszer felhasználói függvényt (azaz makrót) írunk, mikor van arra egy értelmes VBA funkció (Workbook.Path), hogy megtudjuk a file elérési útját, ráadásul itt nem zavar be semmilyen más tényező, az utolsó tag az a mappa, amelyikben a fájl van.
Public Function neve() As String
Dim mappa As String
mappa = ThisWorkbook.Path
neve = Split(mappa, "\")(UBound(Split(mappa, "\")))
End FunctionÜdv.
-
-
Fferi50
Topikgazda
válasz
poffsoft
#33791
üzenetére
Szia!
Valószínűleg:
mappa=split(mappa,"\")(ubound(split(mappa,"\")))
Még az jutott eszembe, nem biztos hogy az aktulális könyvtár (ami a curdir() eredménye) ténylegesen megegyezik az éppen megnyitott munkafüzet mappájával, ezért valószínűleg biztosabb lenne az
Activeworkbook.Path használata.Üdv.
-
nordican
tag
válasz
poffsoft
#33782
üzenetére
Basszus, nem értem, miért fejlécet írtam. Szóval az élőfejre gondoltam. Beraktam oda egy azonosító kódot, aminek a munkalap egyik cellájában automatikusan meg kellene ismétlődnie, de sehogyse tudok rá hivatkozni. Sőt ezt még meg kéne fejelnem azzal, hogy az élőfejben lévő kód mindig annak a mappának a nevét kapja automatikusan, ahol a munkafüzetet tárolom (magyarul a kód egyúttal a mappa neve lenne), mert a munkafüzet egy sablon, amit mindig egy adott mappába teszek, és ott testre szabok. Ha ez utóbbira lenne megoldás, az is nagy könnyebbség lenne, akkor még a hivatkozásról is lemondanék.
-
-
nordican
tag
válasz
poffsoft
#33777
üzenetére
Köszi, ez az! Igen, munkalapokra gondoltam.
A 10-zel nekem sortörést is csinált, lecseréltem hasraütésszerűen 9-re, és most már egymás mellé mennek a tételek. Újabb kérdés: Ha sok tételből áll az összesített cella, és több sorra csúsznak át, jó lenne, ha automatikusan átméreteződne a cella magassága. próbáltam már az automatikus sormagassággal, sortöréssel és anélkül, de meg se kottyan neki. Erre van ötleted? (Ja, most olvasom, hogy a sortörést írtad is.) -
kikisell
újonc
válasz
poffsoft
#33747
üzenetére
Ennyit lát a kolléga, amit ide beillesztettem képként. A fájl nevét kitakartam, nem publikus, de nem is érdekes, a kiterjesztés azért látszik, ez egy makrós sablon excel fájl.
Szóval egyszerre 1 felhasználó nyitja meg írásra is, azt mondja, a megnyitásnál nincs semmi gond, nem ír ki semmit a fájl, meg tudja nyitni, tud bele írni, csak a mentésnél kiabál vissza. Akik csak olvasásra nyitják meg, mert csak annyi kell nekik, hogy lássák az adatokat, és nyomtatni tudjanak belőle, azok igazából csak 1-1 másolatát nyitják meg, tehát nem is a fő fájlt. Ők időnként ráfrissítenek, hogy lássák a fő fájl aktuális adatait.
Még az jutott eszembe, hogy pont egyszerre megy valakinél a saját másolatának a frissítése a másik felhasználó mentésével és az kavarja össze a fájlt. Most minden esetre kipróbáljuk, ami eszünkbe jut.
Eddig ilyen nem volt, pár éve használjuk már, és most jelentkezik ilyen először. Ami változás történt a rendszeren a kezdetek óta, hogy új az Office csomag. -
EmberXY
veterán
válasz
poffsoft
#33691
üzenetére
+ Fferi50:
Nekifutottam, teljes sötétségben, beillesztettem a kódot a megadott módon, de a dokumentum megnyitásánál a következő hibaüzenetet kapom: Compile error: End If without block If.
Kipróbáltam úgy is, hogy a thisworkbook lapon a Workbook és az Open van kiválasztva, oda illesztettem a kódot, ekkor a megnyitásnál az a hibaüzenet, hogy Compile error: Expected End Sub.
Mit csinálhattam rosszul? Rossz helyre tettem, vagy kihagytam valamit?
-
Fferi50
Topikgazda
válasz
poffsoft
#33677
üzenetére
Szia!
"Azt látod, hogy a két sor nem ugyanaz? "
Nem is lehet ugyanaz. Gondolom, észrevetted, hogy 30 * 2,4 semmilyen kerekítéssel nem lesz 48.
Ha a 2,4-es szorzóval mész végig a kerekítéses módon, nem lesz az összeg 500, vagy az összeg nem jó, vagy a szorzó. Az Excel célérték keresése sem tudott hasonló feltételekkel eredményt produkálni.
Ezért gondoltam azt, hogy a mértani sorozat (hiszen ha minden tag az előző tag ugyanakkora szorosa, akkor erről van szó) elemeinek kerekítése adhatja a jó megoldást. Szerintem ezzel lehet a 2 feltételt egyidejűleg teljesíteni.
Aztán ez vagy megfelel a kérdező elvárásainak vagy nem.Üdv.
-
Magnat
veterán
válasz
poffsoft
#32844
üzenetére
Köszi azért, átírtam mindenhol len-re, azzal műxik.
Még egy kérdés, nem csak neked
: Az Intellisense működése nem tiszta... pl akarom tudni a Cells metódusait, tulajdonságait, stb. Beírom, h "Cells." és a pont lenyomása után segít az Intellisense - vagy ha nem, akkor Ctrl+J-re biztosan. Akkor is segít, ha ezt írom: "Cells()." - viszont pont úgy, ahogy normálisan használni kell, pl. "Cells(1,1).", nem működik. Hiába nyomkodom a Ctrl+J-t, csak dingel. Miért? -
Fferi50
Topikgazda
válasz
poffsoft
#32838
üzenetére
Szia!
Sajnos a Help is félrevezető ebben a tekintetben. A MÓDUSZ.TÖBB akkor írja ki a több számot, ha az előfordulásuk azonos - vagyis több értéket lehet módusznak tekinteni, ha csak egy módusz van, akkor csak azt az egy számot fogja így is kiírni és nem adja meg az utána következő előfordulásokat.
Csak nagyon figyelmesen elolvasva a Helpet, jön át ez a "korlátozás":
"A =MÓDUSZ.TÖBB(A2:A13) képletet tömbképletként kell beírnia. Ebben az esetben a MÓDUSZ.TÖBB 1, 2 és 3 értéket ad vissza móduszként, mivel mindegyik háromszor jelenik meg".Üdv.
-
Delila_1
veterán
válasz
poffsoft
#29953
üzenetére
Rendben.
Sub dolgozik()
' Billentyűparancs: Ctrl+d
ActiveCell = "dolgozik"
ActiveCell.Offset(1,0).Select
End SubAz Offset függvény, mint a magyar neve (eltolás) is mutatja, az aktív helytől – vagy a megjelölttől, pl. range("B5").offset(...,...) – való eltolást mutatja. Ha mindkét paraméter 0, akkor helyben topogunk, gyakorlatilag 0 az eltolás.
-
Fferi50
Topikgazda
válasz
poffsoft
#29574
üzenetére
Szia!
Lehet, hogy olyankor, amikor nem frissül az érték, ki van kapcsolva az automatikus számolás.
Másrészt:
Delila válaszában szerintem tulajdonképpen benne volt a 2. kérdésedre is a felelet. A függvényeidben használni kell az
Application.Volatile
metódust, ekkor a függvényértéket azonnal újraszámolja az excel automatikusan, amint az adott munkalapon egy cellának megváltozott az értéke.
Hátránya, ha sok volatile függvényed van, az bizony lassítja az excelt rendesen (cserébe az azonnali számolásért).Egyébként csak akkor számolódnak újra a függvények, ha valamelyik tényezőjük megváltozik - de ehhez is az automatikus számolásnak kell élnie.
Üdv.
-
Belnir
csendes tag
-
Belnir
csendes tag
válasz
poffsoft
#29468
üzenetére
Az if aktualis vizsgálat nem kell, csak fogalmam sincs, hogy mire vonatkozik...
Gyakorlatilag próbálkozom, az általatok adott kódokat fabrikáltam össze, ez működött, de nem 100%-osan. Szóval fogalmam sincs, mi a fölös sor és mi hiányzik.
plusz ha valaki több cellát módosít, töröl egyszerre, arról sincs logod sajnos igen, ez így van.
if target.count
helyett az értéket csak az 1. cellában nézd:
target(1,1).value
?
a writeline végére még beszúrnék egy lezáró "-" -t, hogy látsszon az üres érték is (ami a törlés).
Megtennéd, hogy kipucolod a szemetet és pótlod ami szükséges?
Csak még nagyobb katyvaszt csinálnék 
Köszi!
-
Delila_1
veterán
válasz
poffsoft
#29372
üzenetére
Poffsoft , Belnir és bsh
Tegnap csak a lényeg maradt ki, a figyelt lapok változásának a követése.
A megfigyelt laphoz kell rendelni a lenti 2 makrót, hogy az ezen történt változásokat is tárolják a Rejtett lapon. A "Rejtett" lap Visible tulajdonságát eleve xlSheetVeryHidden-re lehet állítani, azért a makró tud bele írni.
Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
If Target.Count <> 1 Then Exit Sub
If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rejtett")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & lastrow)
.Offset(0, 0) = Target.Parent.Name 'A – hol volt változás
.Offset(0, 1).Value = Target.Address 'B – Változás helye
.Offset(0, 2).Value = Now() 'C – időpont
.Offset(0, 3).Value = aktualis 'D – változás előtti adat
.Offset(0, 4).Value = Target.Value 'E – változtatás utáni érték
.Offset(0, 5).Value = Environ$("username") 'F – felhasználó neve
.Offset(0, 6).Value = Environ$("computername") 'G – PC neve
.Offset(0, 7).Value = Environ$("userdomain") 'H – felh. domain
End With
End With
Worksheets(akt_lap).Activate
Selection.Activate
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub -
bsh
addikt
válasz
poffsoft
#29356
üzenetére
most ezt úgy kérdezem, hogy ekcellhez nem értek, meg nem is próbálom ki mert őőőő ezer a dolgom
![;]](//cdn.rios.hu/dl/s/v1.gif)
de ez hogyan is akar működni? bezárás előtt beleír a táblázatba, amitől az megváltozik. ilyenkor nem ajánlja fel a mentést az ekcszell? mert akkor megint ment, de ugye aftershave megint beleír, amitől megint nem tudod bezárni, goto 10, nem? -
-
MCGaiwer
addikt
válasz
poffsoft
#29063
üzenetére
oké, akkor egy másik megoldást próbálnék:
kirakok két macro gombot. az elsőt megnyomom (vagy ha megoldható, hogy rögtön indulás után lefusson, akkor úgy lenne a legjobb), ez csinál egy coppyt "A" sheetről.
ezután dolgozok "A" sheettel szokás szerint. Mikor végzek és bezárom az excelt, megnyomom (vagy ha zárás előtt lefutna magától, úgy lenne a legjobb) a másodikat, ami összehasonlítja "Acoppy"-t és az időközben általam módosított "Aeredeti"-t, akkor ahol nem egyeznek az értékek (tehát módosítva lett a cella) kiírja az adott dátumot "Aeredeti"-re majd törli "Acoppy"-t
-
MCGaiwer
addikt
válasz
poffsoft
#29059
üzenetére
akkor sajnos ez nem lesz jó, mert azon a sheeten, ahol a macro fut nem működik az undo
úgy nem lehet, hogy ha én "B" sheeten egy cellát egyenlővé teszek "A" sheeten egy cellával (ami tehát módosul ha "A"-n módosítom a cellát), akkor a macro a "B"-t figyelje és a "B"-re is írjon?
-
-
lenkei83
tag
válasz
poffsoft
#28946
üzenetére
worksheets().name = range("f2").text -el
F oszlopban vannak a munkalapok nevei, range("f2").text-et írok be, azzal is működik.Ami csavar a dologban, hogy a munkalapok egymás alatt vannak egy oszlopban és ezeket kellene valahogy bepakolni képletbe. Mármint hogy ne mindig az F2-t vegye fel értéknek hanem az F(adott_sort)
Most így néz ki: (tudom, nem nagy dolog VBA-ban egy képletet megírni, utólag belegondolva nem is értem miért nem ment
)Set ws = Sheets(salesK_sheet.Range("F2").Value)
oszlop.Formula = "=sumifs('" & ws.name & "'!B, '" & ws.Name & "'!A:A, B2, '" & ws.Name & "'!V:V,E2)"A ws.name-et kellene valahogy változóba rakni adott sornak megfelelően.
Van erre valami ötlet?
-
-
ueva
csendes tag
válasz
poffsoft
#28794
üzenetére
Szia!
Bocs, hogy ilyen zavarosan adom elő, de először én is félreértelmeztem a problémát.
Megpróbálom kevésbé zavarosan leírni.
Szóval:
Van néhány magasság adatom, amelyeket gondolatban 10 m-es sávokra fel kell osztani, majd megadni, hogy az egyes sávokba hány adat tartozik. Ehhez kellet a GYAKORISÁG.(A színezést itt csak manuálisan végeztem)
Aztán jött az új kihívás, hogy ezeket a sávokat ki kell emelni úgy, hogy az azonos sávba tartozó magasságok azonos háttérrel, a különböző sávokba tartozó, viszont a táblázatban „szomszédos” magasságok adatai eltérő háttérszínnel jelenjenek meg! Első sáv adatai fehér, következő kék...stb. Csak arra nem figyeltem, hogy a színezés automatikusan reagáljon minden (a magasságok eredeti, monoton csökkenő rendezettségét megtartó) adatváltozásra! Tehát, ha pl. a 2634 m-es magasságot átírom 2640 m-re, akkor így már az a 40-es sávba fog tartozni, tehát kék színű. A 30-as sáv gyakorisága 0, a 20-as sávnak így fehérnek kell lennie.
Valahogy így:
De, ha a feltételes formázásban lefixálom, hogy melyik sáv milyen színű legyen, akkor nem fogja követni a változásokat.
Most egy kicsit érthetőbb voltam?
Nagyon köszi a segítséget előre is!
Üdv -
ueva
csendes tag
válasz
poffsoft
#28780
üzenetére
Szia!
Mégsem működik!
Az én hibám félreértelmeztem a feladatot.
A feltételes formázást 2 színnel kell csak elvégezni. A legnagyobb érték fehér hátterű legyen a többi sávba tartozó pedig ennek megfelelően kék/fehér felváltva.
A sávok: 2659-2650i, 2649-2640, 2639-2630,.....,2509-2500.
Ezt úgy oldottam meg, hogy a feltételes formázáshoz a következő két szabályt írtam:
=MARADÉK(KEREK.LE($A2/10;0);2)=1 --> FEHÉR HÁTTÉR
=MARADÉK(KEREK.LE($A2/10;0);2)=0 -->KÉK HÁTTÉR
Aztán utána néztem, hogy abban az esetben, ha valamelyik értéken módosítok, akkor attól függően a formázásnak is követnie kell.
pl: Ha a 4. értéket a 2634-et 2640-re módosítom, akkor mivel 3 érték esik a 2640-es sávba mindhárom kék színű viszont az utána következő sávnak már fehérnek kell lenni.
Ilyennek kéne lenni:
Nekem viszont nem az, mivel a képletem szerint 10-zel osztva az is páros.
Az enyém így néz ki:
Hogy lehetne úgy megadni a formázás szabályát, hogy helyesen működjön?
Nagyon köszönöm!
Üdv.
)
ez a része nekem nagyon nem ment sosem... 
27;"Cég neve";D3
27)
100")
![;]](http://cdn.rios.hu/dl/s/v1.gif)
de ez hogyan is akar működni? bezárás előtt beleír a táblázatba, amitől az megváltozik. ilyenkor nem ajánlja fel a mentést az ekcszell? mert akkor megint ment, de ugye afters
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Új, bontatlan World of Warcraft gyűjtői kiadások
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Samsung Galaxy A22 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓ! ASUS B650M R5 7600X 64GB DDR5 1TB SSD RTX 3080Ti 12GB Be Quiet! Pure Base 500FX ASUS 1000W
- Telefon felvásárlás!! Samsung Galaxy S25, Samsung Galaxy S25 Plus, Samsung Galaxy S25 Ultra
- Bomba ár! Dell Latitude 3590 - i5-8GEN I 8GB I 256SSD I HDMI I 15,6" FHD I Cam I W11 I Garancia!
- Bomba ár! Lenovo ThinkPad X270 - i5-6G I 8GB I 256GB SSD I 12,5" FHD I HDMI I Cam I W10 I Garancia!
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest