- Samsung Galaxy Watch6 Classic - tekerd!
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Poco F3 - a mindenes, de nem mindenkinek
- Honor Magic V5 - méret a kamera mögött
- Samsung Galaxy Z Fold7 - ezt vártuk, de…
- Yettel topik
- Samsung Galaxy A52s 5G - jó S-tehetség
- 165 Hz-es panelt tesztel a OnePlus
- Szuperkijelzővel készül a Huawei Mate 80 RS
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
Hirdetés
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
slashing
senior tag
válasz
slashing
#24520
üzenetére
oké tényleg nagy marha voltam végig az első if-es résznél próbálkoztam ami ugye a páros sorokra érvényes de én barom mindig a páratlan sorban teszteltem aminél jóhogy nem ment
lényeg a lényeg sikerült
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row Mod 2 = 0 Then
If Not Intersect(Range("D3:AB100"), Target) Is Nothing And Target.Value = "x" Then
Range("D1:AB2").Interior.ColorIndex = 6
Range(Cells(2, Target.Column), Cells(2, Target.Column)).Interior.ColorIndex = 37
Else
Range("D1:AB2").Interior.ColorIndex = 6
End If
Else
If Not Intersect(Range("D3:AB100"), Target) Is Nothing And Target.Value = "x" Then
Range("D1:AB2").Interior.ColorIndex = 6
Range(Cells(1, Target.Column), Cells(1, Target.Column)).Interior.ColorIndex = 37
Else
Range("D1:AB2").Interior.ColorIndex = 6
End If
End If
End Sub -
-
lumpy92
aktív tag
válasz
slashing
#24515
üzenetére
Szuper,alakul a dolog, már csak annyi a bibi,hogy az egyes ciklusokat nem szedi szét,hanem a 60-100ig kiszámolt értékek összegeit írja be a másik fülön az első (L4) cellába,a többit pedig kinullázza, valahogy a folyamatnak a ciklikussága nincs meg. Most az egész parancs egy Do-Loop között van,de ha jól értem a dolgokat,ezt így is kell?
-
Fferi50
Topikgazda
válasz
slashing
#24471
üzenetére
Szia!
Az egészen biztos, hogy az automatikus kalkuláció tud problémákat okozni, főleg a következő esetekben:
Amikor olyan munkalap függvények vannak "tömegesen", amelyeknek az értéke frissítés (pl. ilyen az indirekt függvény is), vagy olyan saját függvényt használunk, amelyben benne van az Application.Volatile sor.
Ezek miatt ugyanis minden, de minden egyes cellaváltozáskor újraszámolódik az összes képlet értéke, akkor is, ha nem az azokban érintett cellák változtak.Nagyon sok adatunk van - sok munkalapon, esetleg még külső hivatkozásokkal (lekérdezésekkel) megspékelve és a külső adatok frissítése automatikusra van állítva.
Ilyen esetekben segít, ha a megnyitás előtt a számolást kézire állítjuk át (Application.Calculation=xlCalculationManual), és csak akkor hívjuk meg a számolás, ha ténylegesen változtattunk valamit.
Az újabb excel változatokban makróból már lehet hívni a számolást úgy is, hogy csak az adott munkalapot, vagy az adott cellatartományt számolja újra (de úgy emlékszem, ez az opció csak makróból megy).Segít még az is, ha a külső adatok automatikus frissítését letiltjuk és makróból vagy kézzel frissítünk.
Ha nagyon lassan jön be egy munkafüzet, ilyenekre lehet gondolni.
Üdv.
-
#24472
m.zmrzlina
senior tag
slashing
#24469
m.zmrzlina
senior tag
válasz
slashing
#24469
üzenetére
Nekem van ilyen makróm. Ha csak az a munkafüzet van megnyitva amiben a makró van akkor 1-2 mp egyébként halál hosszú (végig sem szoktam várni)
Biztos vagyok benne, hogy elcsesztem valamit a makróban de még kérdezni sem tudok vele kapcsolatban semmi konkrétat úgyhogy nem is túráztattam vele senkit sem itt a fórumon sem máshol.
Szerencsére csak én használom ezért tudom hogy mielőtt azt indítom bezárok minden mást és így simán lefut.
-
slashing
senior tag
válasz
slashing
#24469
üzenetére
Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomaticazthiszem az lehetett a gond hogy a menyitott fájlban van egy tömbfüggvény amit lehet minden egyes cellaváltásnál újraszámolt(talán) és mivel van vagy 30 munkalap benne így ezeket szerintem mindig újraszámolta(talán)...
-
slashing
senior tag
-
slashing
senior tag
válasz
slashing
#24396
üzenetére
Áááágghrrrrr nem tudom már még1x szerkeszteni ha a végére még beszúrjuk ezt is ;"link" akkor csak annyi fog látszódni hogy link nem a teljes elérési út nem kell külön fölé rakni egy link szöveget is:
=HIPERHIVATKOZÁS(BAL(CELLA("filenév");SZÖVEG.KERES("[";CELLA("filenév"))-1)&"ipari_mt.pdf";"Link")
-
Fferi50
Topikgazda
válasz
slashing
#24161
üzenetére
Szia!
A "szépség" arra épít, hogy egyedi "azonosítók" vannak...Ami cégnevek esetében eléggé kézenfekvőnek tűnik, hiszen miért is vinném fel kétszer ugyanazt az ügyfelet - ha több telephelye és cime van, akkor hozzáteszem a telephelyét pl.
A dátumokkal kicsit más a helyzet, hiszen események történhetnek azonos napokon bőven. Meg lehet próbálni a ha függvénnyel megnézni, hogy az eredmény egyezik-e az előző értékkel, de ekkor szerintem nem +1 a hozzáadnivaló, hanem az új találat helye.
Másrészt az első oszloppal (igen - nem) szabályozni tudod a kiválasztást szerintem.Bocsi, most nem néztem meg a gyakorlatban, csak elméletileg futottam egy kört - lehet, hogy hibás következtetésre jutottam.
Üdv.
-
Fferi50
Topikgazda
válasz
slashing
#24158
üzenetére
Szia!
Az advanced filternek valóban az a "heppje", hogy a célnak - de csak annak - az aktív munkalapon kell lennie.
De, ha csak egy oszlopból szeretnéd kiválogatni az egyedi értékeket, akkor csináld a következőt (2007-es exceltől kezdve működik):
sheets("akarmi").usedrange.columns("A").copy sheets("akarmi").range("D1")
usor=sheets("akarmi").range("D1").end(xldown).row
sheets("akarmi").range("D1:D" & usor).RemoveDuplicates columns:=1,header:=xlNoÉs máris megvan az egyedi listád, ez a pár sor működik rejtett munkalapon is.
Üdv.
-
Fferi50
Topikgazda
válasz
slashing
#24154
üzenetére
Szia!
Ha a select előtt megnézed, hogy látható-e a sheet, ha nem akkor előtte láthatóvá és aktívvá teszed.
If sheet_akarmi.visible<>xlsheetvisible then sheet_akarmi.visible=xlsheetvisible
sheet_akarmi.selectÜdv.
Egyébként pedig szerintem meg kellene oldani a feladatot select nélkül. Az működik hidden és veryhidden állapotú munkalapnál is.
-
PETEE78
senior tag
válasz
slashing
#24098
üzenetére
Teljesen igazad van..
Előtte egy kérdésem volna, ha ezel sem sikerül, akkor csinálok egy minta filet.
Egy adott oszlopra (I) rászűrtem. a végére szeretnék darabszámot kapni a nem üres cellákról úgy, hogy az ismétlődő cellákat csak egyszer számolja az oszlopon belül. Függvény, szűrési feltétel bármivel megoldható..
-
Fferi50
Topikgazda
válasz
slashing
#23998
üzenetére
Szia!
Igazad van.
Csinálni kell egy segédoszlopot, amibe összefűzzük a négy oszlop celláit és abban keressük a vizsgálandó sor összefűzött értékét. Az összefűzésnél akár elválasztó jelet is alkalmazhatunk.
Tehát Delila példájánál maradva: H1 =D1&E1&F1&G1 ezt kell végighúzni a H oszlopban, majd az I4 cella képlete:
=HA(Darabteli($H$1:$H4;D4 & E4 & F4 & G4)>1;"x";"")Üdv.
-
bteebi
veterán
válasz
slashing
#23982
üzenetére
slashing, Fferi, Delila, köszönöm!
slashing: Tényleg elég képként, sőt máshogy nem is nagyon lehet. Közben amúgy még tegnap este magamtól is módosítottam a makrón emiatt, mert ha csak lemásoltam a diagramot (tehát "élő" hivatkozás volt a forrásadatra), akkor hiába generálta le mind az 50 ábrát, csak egyfélét jelzett ki (a legutolsót), mivel fix adatokra hivatkozott
. A változás egyébként minimális, ActiveSheet.Paste
helyett
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)". Amúgy képpel tényleg könnyebb dolgozni. Jártam már úgy, hogy a szerkeszthetőség miatt először csak simán bemásoltam az ábrákat Wordbe, de kicsit szétcsúsztak, úgyhogy végül képként lett beillesztve az összes.A Worddel még majd futok egy kört.
Fferi50: Köszönöm, ki fogom próbálni. Az utóbbi két válaszodból egyértelműen kitűnik, hogy nem ártana (valahonnan) megtanulnom az alapokat, hogy ne kérdezzek alapvető hülyeségeket is
.Delila: Köszönöm, hasznos infó ez is.
-
#23886
Dr. Romano
veterán
slashing
#23884
-
róland
veterán
válasz
slashing
#23797
üzenetére
Képlet akkor használható, ha a végső helyen dolgozok.
Ez egy segédtábla, ami minden nap üresen nyílik meg, beírnak pár adatot, majd a végső tábla megfelelő sorába kell azt átrakni. (A kérdéses sort a HOL.VAN függvénnyel lehet megkerestetni.)
A képlet akkor jó, ha a célhelyen kezdeményezem a keresést a források között. Itt viszont a forrásból kezdeményezem az adat átadását.
Mint írtam az is cél, hogy az adatot rögzítő a teljes adattáblához ne férjen hozzá. Kizárólag az aznapi adatokat látná.
-
Delila_1
veterán
válasz
slashing
#23751
üzenetére
Klassz az oldal.
Többnyire ahhoz szükséges 1-1 függvény angol neve, ha makróban szeretnénk alkalmazni. Internet nélkül is megtudhatjuk a nevét.
Beírjuk a függvényt a lapra, így kipróbálhatjuk, hogy működik-e. Lapfülön jobb klikk, Beszúrás, Nemzetközi makrólap. Kapunk egy új lapot Makró1 névvel.
Átmásoljuk a függvényt tartalmazó-, valamint az(oka)t a cellá(ka)t, ami(k)re hivatkozik.Az új lapon a függvény cellájában, és a szerkesztőlécen angolul jelenik meg a függvénynév, ha rákattintunk, magyarul láthatjuk.
-
Fferi50
Topikgazda
válasz
slashing
#23726
üzenetére
Szia!
Azért javaslom, nézd meg ezt is. Egyetlen követelmény, hogy a másolandó adatok az első oszlopban kövessék egymást - úgy ahogyan a képeken is van.
Sub masolo()
Dim mlap1 As Worksheet, masolando As Range, mlap2 As Worksheet, hovasor As Double, hovaoszlop As Double
Set mlap1 = Workbooks("Munkafüzet3").Sheets("Munka1")
Set mlap2 = Workbooks("Munkafüzet4").Sheets("Munka1")
Set terulet = mlap2.UsedRange
hovasor = terulet.Rows.Count
If terulet.Cells(1, hovasor) = "" Then
Do While True
If terulet(1, hovasor).End(xlToRight).Column < terulet.Columns.Count Then Exit Do
hovasor = hovasor - 1
Loop
End If
hovasor = hovasor + 1
Set terulet = mlap1.Range("A1").CurrentRegion
Do While True
For oszlop = 1 To terulet.Columns.Count
hovaoszlop = Application.IfError(Application.Match(terulet.Cells(1, oszlop), mlap2.Rows("1:1"), 0), 0)
If hovaoszlop <> 0 Then
Intersect(terulet, terulet.Offset(1, 0)).Columns(oszlop).Copy mlap2.Cells(hovasor, hovaoszlop)
End If
Next
hovasor = hovasor + terulet.Rows.Count - 1
Set terulet = terulet.Range("A1").End(xlDown).End(xlDown).CurrentRegion
If Intersect(mlap1.UsedRange, terulet) Is Nothing Then Exit Do
Loop
MsgBox "A másolás megtörtént!", vbInformation, "Másolás"
End SubÜdv.
-
Delila_1
veterán
válasz
slashing
#23720
üzenetére
Nem teljesen olyan, mint a képen, de hasonlít.
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.Sub Oszlopok()
Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
Dim WF As WorksheetFunction, sorhova As Long
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
Set WF = Application.WorksheetFunction
sor = 1
WS1.Select
Do While Cells(sor, 1) <> ""
uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
For oszlop = 1 To uoszlop
cim = Cells(sor, oszlop)
On Error GoTo Tovabb
oszlophova = WF.Match(cim, WS2.Rows(1), 0)
Cells(sor + 1, oszlop).Select
usor = Selection.End(xlDown).Row
sorhova = WS2.Cells(Rows.Count, oszlophova).End(xlUp).Row + 1
Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
Tovabb:
On Error GoTo 0
Next
sor = Range("A" & sor).End(xlDown).Row
sor = Range("A" & sor).End(xlDown).Row
Loop
End Sub -
Fferi50
Topikgazda
válasz
slashing
#23720
üzenetére
Szia!
Most ellenőriztem, sajnos a speciális szűrés nem megy, mert ha nincs olyan fejléc a szűrendő mezőben, akkor hibát dob (bár nem egészen értem a logikáját, hogy miért, de ez van, ezt kell elfogadni.)
Másik ötlet:
Képlet szinten: Hol.van függvénnyel meghatároznám, hogy az adott fejléc hanyadik oszlopban van a másik táblában és abba az oszlopba kell tenni az adatot. (Nyilván ezt le lehet makróval rendezni (match függvény)).
Tehát: kb.így nézne ki
set mlap1=workbooks("Munkafüzet3").sheets("Munka1")
set mlap2=workbooks("Munkafüzet4").sheets("Munka1")
itt kezdheted az oszlopok ciklusát
oszlop=application.match(mlap1.range("A1").value;mlap2.rows('"1:1"),0)
if not iserror(oszlop) then ' ez csak azért kell, ha mégsem lenne olyan fejléc a másik munkalapon
yy=mlap.cells(40000,oszlop).end(xlup).row+1
for xx=2 to mlap1.range("A2").end(xldown).row
mlap2.cells(yy,oszlop).value=mlap1.cells(yy,"A").value
yy=yy+1
next
else
msgbox "Nincs ilyen fejléc: " & mlap1.range("A1").value
endif
next oszlopokA makró csak szemléltető, nem feltétlenül hibátlan.
Ezt végigcsinálod minden oszlopon, és minden kis táblán.
Ha deklarálod a változókat, az oszlop mindenképpen variant legyen, mert annak értéke hiba is lehet, mint látod.Remélem érthető és tudod használni.
Üdv.
-
slashing
senior tag
válasz
slashing
#23720
üzenetére
Amúgy én úgy képzelem/képzeltem el hogy először megkerestetem a célfájl azon sorát amiben a legtovább van adat ezt eltározom egy változóban sorazonosítóként aztán van egy ciklusom ami végigfut az első tábla fejlécsorán mégpedig úgy hogy csinál egy keresést a másik fájl fejlécében és ahol megtalálja az egyezőt ott eltározom az oszlop azonosítót ha ez meg van akkor van egy sor és oszlopazonosítom ahova bemásolhatja az adatokat. Arra mondjuk figyelni kell hogy a sorazonosító ne legyen ciklusban nehogy lépcsős legyen az egész. Így leírva milyen egyszerű
-
Fferi50
Topikgazda
válasz
slashing
#23716
üzenetére
Szia!
Ha jól értem, akkor a fejlécek különbözőek, csak más-más sorrendben vannak.
Ebben az esetben én a következőt javaslom:
Csinálj egy "átmeneti" táblát(munkalapot), ahová a fejléceket a második táblában levő sorrendbe teszed be. (Praktikusan beillesztesz egy munkalapot és ide bemásolod a második tábla első sorát).Ezután az első tábládra csinálsz egy "advanced filtert", ahol a szűrendő tartomány az első tábla usedrange, a szűrőfeltétel az átmeneti tábla első sora és új helyre másolás helyének kijelölöd az átmeneti tábla első sorát.
Végrehajtod az irányított/speciális szűrést - ekkor az átmeneti tábládban már ugyanolyan sorrendben lesznek az oszlopok, mint a második táblában. Innen már csak egy sima copy kell és az átmeneti tábla törlése.DE még egyszerűbb szerintem a következő:
Szintén advanced filter, a következők szerint:
Szűrendő az első táblád
Feltétel: a második táblád fejléc sora (csak az első sor!)
Másolás helye: a második táblád vége!
Új helyre másolással a szűrés végrehajtása.
Az tábla közben (az eredeti második tábla utolsó sora után) keletkező "álfejléc" sor törlése. Nyilván ezt akkor tudod megtenni, ha megjegyezted, melyik sort jelölted ki másolási célnak.Talán bonyolultnak tűnik, de hidd el egyszerűbb megcsinálni, mint leírni volt.
Én rögtön a második verzióval kezdeném.Üdv.
-
Carasc0
őstag
válasz
slashing
#23566
üzenetére
Továbbra sem ez a gondom. Máshogy teszem fel a kérdést:
Hogy lehet úgy képletet másolni tetszőleges irányba hogy a képletnek csak az a része változzon amit én a másolandó képletbe megváltoztattam. Írok rá extra primitív példát:
10
11
12
13
14
15
16Tegyük fel megváltoztatom a 10-et 20-ra. Ha másolnám a 20-at akkor így legyen az eredmény:
20
21
22
23
24
25
26Tehát csak az a része változzon amit én megváltoztatok....többi maradjon a helyén.
-
Delila_1
veterán
válasz
slashing
#23474
üzenetére
Sub tele_e()
Dim usor As Long, uoszlop As Integer, oszlop As Integer, maxx As Long, f As Boolean
uoszlop = Range("D4").End(xlToRight).Column
For oszlop = 4 To uoszlop
usor = Cells(Rows.Count, oszlop).End(xlUp).Row
If usor > maxx Then maxx = usor
Next
For oszlop = 4 To uoszlop
If Application.CountA(Range(Cells(4, oszlop), Cells(maxx, oszlop))) <> maxx - 4 + 1 Then
f = True
End If
Next
If f Then MsgBox "Hiányos" Else MsgBox "Rendben"
End Sub -
Delila_1
veterán
válasz
slashing
#23472
üzenetére
Sub tele_e()
Dim sorok As Long, oszlopok As Integer
Range("A4").Select
Selection.CurrentRegion.Select
sorok = Selection.Rows.Count: oszlopok = Selection.Columns.Count
If sorok * oszlopok <> Application.CountA(Selection) Then
MsgBox "Hiányos kitöltés"
Else
MsgBox "Rendben"
End If
End Sub -
Delila_1
veterán
válasz
slashing
#23400
üzenetére
Azért egy másik, ami azt figyeli, hogy a saját felhasználói neveddel léptél-e be.
Sub mmmm()
Dim nev$
nev$ = Application.InputBox("Add meg a neved!", "Név bekérése", , , , , , 2)
If nev$ <> Environ("username") Then
MsgBox ("Te kis huncut, nem vagy jogosult a füzetet használni!"), vbOKOnly + vbExclamation
Exit Sub
Else
MsgBox "Tovább..."
'makró többi része
End If
End Sub -
Delila_1
veterán
válasz
slashing
#23396
üzenetére
Beviszed a neveket egy oszlopba. Táblázattá alakítod, és a Nevek névvel látod el a tartományt.
Sub mm()
Dim nev$, tomb(), v As Integer, megvan As Boolean
nev$ = Application.InputBox("Add meg a neved!", "Név bekérése", , , , , , 2)
tomb = Application.Transpose(Range("Nevek"))
For v = 1 To UBound(tomb)
If nev$ = tomb(v) Then
megvan = True
Exit For
End If
Next
If megvan = False Then
MsgBox "Nem szerepelsz a nevek között!"
Exit Sub
Else
MsgBox nev$ & " a(z) " & v & ". helyen szerepel."
'makró többi része
End If
End SubBővítheted agyba-főbe a tartományt.
-
#23395
m.zmrzlina
senior tag
slashing
#23393
m.zmrzlina
senior tag
válasz
slashing
#23393
üzenetére
Én ezt egyszer úgy oldottam meg, hogy az inputboxban megadtam a formáját a neveknek amit elfogad a makró.
technikus = UCase(InputBox("Add meg a technikus nevét!" & Chr(10) "TUDOR VIDOR SZENDE SZUNDI MORGÓ HAPCI KUKA MIND"))
If technikus <> "MIND" Then
If Application.WorksheetFunction.CountIf(Worksheets("PrnWinExcel").range("B:B"), technikus) = 0 Then
MsgBox "Nincs ilyen technikus."
Exit Sub
ElseIf technikus = "" Then
Exit Sub
End If
End IfPersze ez csak akkor működik ha minden elfogadható input ismert a programozás idején, nem bővül vagy egészül ki esetleges elemekkel a Worksheets("PrnWinExcel").range("B:B") tartomány vagy van lehetőség a folyamatos frissítésére.
-
bteebi
veterán
válasz
slashing
#23384
üzenetére
Azt amúgy hogy lehetne megcsinálni, hogy csak szóköz(öke)t ne adhasson meg névnek? Mert ez
Loop Until nev <> "" And nev <> " " Or nev = False
csak egy karakternyi szóközig működne, n db esetén már nem.Némi keresgélés után sikerült megoldanom, de az azért érdekelne, hogy meg lehetne-e szebben is írni (egyszerűbben minden bizonnyal nem):
Do
nev = InputBox("A mérést végző személy Teljes neve:")
ujnev = WorksheetFunction.Substitute(nev, " ", "")
Loop Until ujnev <> "" Or nev = False -
#23387
m.zmrzlina
senior tag
slashing
#23381
m.zmrzlina
senior tag
-
Mittu88
senior tag
-
#23366
m.zmrzlina
senior tag
slashing
#23365
-
#23364
m.zmrzlina
senior tag
slashing
#23360
m.zmrzlina
senior tag
válasz
slashing
#23360
üzenetére
Nekem ezt sikerült kiötleni:
Sub makro_1()
elsouzenet = InputBox("blablabla1")
masodikuzenet = InputBox("blablabla2")
datum = InputBox("datum")
Range("D5").Select
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
hanysor = Selection.Rows.Count
hanyoszlop = Selection.Columns.Count
For i = hanyoszlop To 1 Step -1
Range(Cells(1, i), Cells(hanysor, i)).Select
Selection.Insert Shift:=xlToRight
Selection.Value = elsouzenet
Next
Range("A:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Value = masodikuzenet
Range("A1").Value = datum
Range(Cells(1, 1), Cells(hanysor, ActiveCell.End(xlToRight).Column)).Select
Selection.Copy
End Sub -
slashing
senior tag
válasz
slashing
#23360
üzenetére
Hát eddig jutottam:
Sub Makró5()
Dim c As Long, myvalue As Variant, lastrow As Long
Range("D5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Munka1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
c = Range("XFD1").End(xlToLeft).Column
For c = c To 2 Step -1
Cells(1, c).EntireColumn.Insert
Next c
myvalue = InputBox("add meg a szöveget")
Range("B1").Value = myvalue
lastrow = Worksheets("munka1").Range("A1").End(xlDown).Row
With Worksheets("munka1").Range("B1")
.AutoFill Destination:=Range("B1:B" & lastrow&)
End With
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
myvalue = InputBox("add meg a dátumot")
Range("A1").Value = myvalue
Range("B1").Select
myvalue = InputBox("add meg a szöveget")
Range("B1").Value = myvalue
End Subközel sem tökéletes pl. a dátum helyére bármit beírhatnék de ez legyen a legkevesebb. Annyi kéne még hogy az első szöveg bekérés után kitölti az oszlopot a megadott szöveggel de ezt tovább kéne vinni az utolsó oszlopig is.
(#23362) Delila_1
Máris nézem köszönöm
-
Delila_1
veterán
válasz
slashing
#23360
üzenetére
A végét írd meg, most el kell rohannom.
Sub valami()
Dim usor As Long, uoszlop As Integer, oszlop As Integer, v$
Sheets("Munka1").Select
Range("D5").CurrentRegion.Copy Sheets("Másik lap").Range("A1")
Sheets("Másik lap").Select
usor = ActiveSheet.UsedRange.Rows.Count
oszlop = 1
Do
Columns(oszlop).EntireColumn.Insert
oszlop = oszlop + 2
Loop While Cells(1, oszlop + 1) <> ""
Columns(oszlop).EntireColumn.Insert
v$ = InputBox("add meg az értéket")
uoszlop = oszlop
For oszlop = 1 To uoszlop Step 2
Range(Cells(1, oszlop), Cells(usor, oszlop)) = v$
Next
End Sub -
slashing
senior tag
válasz
slashing
#23340
üzenetére
jah azt elfelejtettem megkérdezni hogy mit értesz az alatt hogy "egy képlettel" mert egyel sehogy sem mert 3 abszolút eltérő képletről beszélünk... mindegyiknek külön oszlop kell
nálam így volt:
e2,3,4 a csoportok
f1 a létszám g1 a módusz h1 a medián és ezek alatt voltak a képletek...ha a fentiek megvannak akkor ki lehet iratni egy képlettel mindet így:
="a csoport létszáma="&F2&" módusza="&G2& " mediánja="&H2
-
Titkárnő
újonc
válasz
slashing
#23165
üzenetére
köszönöm, nagyon kedves vagy, hogy több variációval is dolgoztál!
A második megoldás nekem sokkal jobban tetszik, mert egyszerűbbnek tűnik, viszont mivel egy oszlop egy hónap és 12 van belőle, nem tudom megoldani, hogy 24 oszlop legyen, átláthatatlan lenne.
A makróval még barátkoznom kell... sosem csináltam még...
Kipróbálom és visszajelzek!Köszi még egyszer!
-
Dolphine
addikt
válasz
slashing
#23125
üzenetére
Azt hiszem, nem tudom elmagyarázni!
Nekem olyan kellene, hogy a számok színe aszerint legyen más, hogy milyen típusú!
Pl. Az összes témazáró jegye piros, vagy a szóbeli felelet száma kék, stb.Fferi50
De szerintem ennél sokkal jobb lenne, ha a három különböző eredményt 3 külön oszlopba írnád az adott tanulónál. Máris megvan oldva a probléma, még az oszlopot is színezheted, ha akarod.Ezt nem egészen értem!
-
Dolphine
addikt
válasz
slashing
#23122
üzenetére
Azt is próbáltam, de az sem az igazi, vagy csak rosszul csináltam.
Szóval az a lényeg, hogy amikor egy érdemjegy (jelen esetben egy szám) rögzítésre kerül, már akkor ki tudjam választani az adott színt, ne később kelljen választanom, mivel előfordul, hogy több tanuló jegyét is rögzítenem.
Így érthetőbb?Ha feltételes formázás, akkor milyen beállítással kellene kezdenem?
-
slashing
senior tag
válasz
slashing
#23089
üzenetére
jah meg most jut eszembe hogy ezt már használtam makróban is ott meg így néz ki
Range("D11").Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",R[-1]C),SEARCH(""["",CELL(""filename"",R[-1]C))+1,SEARCH(""]"",CELL(""filename"",R[-1]C))-SEARCH(""["",CELL(""filename"",R[-1]C))-1)" -
Fferi50
Topikgazda
válasz
slashing
#23031
üzenetére
Szia!
Ide tedd be a másik makró hívását, így:If Not Intersect(Target, Range("H7,H12,H17,H22,H27,H32,H37,H42,H47,H52,N7,N12,N17,N22,N27,N32,N37,N42,N47,N52,T7,T12,T17,T22,T27,T32,T37,T42,T47,T52,Z7,Z12,Z17,Z22,Z27,Z32,Z37,Z42,Z47,Z52,AF7,AF17,AF22,AF27,AF32,AF37,AF42,AF47,AF52")) Is Nothing Then
Application.Dialogs(xlDialogInsertObject).Show
alakzatMeretezes
End IfRemélem, jó helyre gondoltam.
Üdv.
-
. A változás egyébként minimális, 
.
Tényleg csak annyi kéne hogy kijelölöm, beszínezze, és done. Azt hittem ez valami egyszerű menüből elérhető funk.
, nem is tudom, miért nem jutott eszembe...
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- PC Game Pass előfizetés
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- GYÖNYÖRŰ iPhone 15 Pro 512GB Blue Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS3070
- GYÖNYÖRŰ iPhone 13 Pro Max 256GB Sierra Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3103
- Jogtiszta Microsoft Windows / Office / Stb.
- Ventillátorok és tápkábel modding kitűnő árakon! Most extra 10% kedvezmény!
- Samsung Galaxy Tab S6 Lite / 4GB RAM 64GB / Független / 12 Hó Garancia
Állásajánlatok
Cég: FOTC
Város: Budapest