- Linux - haladóknak
- Hálózati / IP kamera
- Anyagi katasztrófára figyelmezteti az Apple-t a brit média
- Linux kezdőknek
- Synology NAS
- Milyen program, ami...?
- Bittorrent topik
- Bocsánatot kért az Apple, mert nagyon mellélőtt a legutóbbi reklámjával
- Mobilinternet
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
-
IT café
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
-
BenJoe80
senior tag
válasz Delila_1 #20087 üzenetére
Szia Delila_1!
Köszi szépen a segítséget.
Bocsi, hogy csak most válaszolok, de közben lebetegedtem és nem tudtam foglalkozni a témával.
Küldtem egy privát üzenetet!
Megisznak egy deci pálinkát. Miért? "Olyan savam vót, meg köllet innom egy deci pálinkát, aszittem megbolondulok." Aztán megisznak négy liter bort. Miért? "Há' semmi savam nem volt má'!"
-
the radish
senior tag
válasz Delila_1 #20136 üzenetére
Sub Feltetel()
Dim sor As Long
For sor = 1 To 18
If Cells(sor, "A") = 1 Then Cells(sor, "B").Copy Sheets("MásikLap").Cells(sor, "I")
Next
End SubEzen kéne úgy módosítani, hogy a "MásikLap" A1 cellájába másolódjon minden, nyomtatás és jöhet a következő másolás.
Megoldható ?
Előre is köszi. -
the radish
senior tag
válasz Delila_1 #20164 üzenetére
Sajnos elakadtam és ez megint annak köszönhető, hogy először nem fogalmaztam elég pontosan.
Szóval két dolog lenne:Cells(sor, "B").Copy Sheets("MásikLap").Range("A1")
A C oszlop tartalma is kéne (B), azt hogy tudom meghatározni? (Próbáltam a "B"&"C" formátumot, de csak tipp volt és természetesen nem jó.
+1 Csak értéket szeretnék átmásolni. (Irányított beillesztés / érték.)
[ Szerkesztve ]
-
Törpella
csendes tag
válasz Delila_1 #20162 üzenetére
Köszönöm a segítséged :-)
Sajnos valamit nem csinálok megfelelően, mert
ezt az üzit kapom:Run-time error '13':
Type mismatchDebug után ezt emeli ki:
If WF.CountA(Range("F" & sor & ":H" & sor)) = 3 And Range("K" & sor) <> "" And _
WF.CountA(Range("P" & sor & ":Q" & sor)) = 2 ThenValamit elrontottam?
Egy "Save" gombhoz akartam hozzárendelni a megírt makrót, de nem sikerül... :-(
Esetleg még egy kis segítség, tanács...?
Az, hogy tanuljam meg, ezek után az elsők között van a listán... -
Attas
aktív tag
válasz Delila_1 #20187 üzenetére
Szia Delila!
Mint már oly sokszor, most is köszönöm a segítséged! Valamiért nem működik. Kicsit átalakítottam, mert azt szeretném, ha a makró tartalmazná a keresési feltételeket. Vagy esetleg a Munk4 A1 és B1 cellája. A makró lefut de nem visz át időadatot.Sub Atmasol()
Dim WS As Worksheet, sor As Long, usor As Long, v$, WF As WorksheetFunction
Dim oszlop As Integer, sor1 As Long, f As Boolean
Application.ScreenUpdating = False
Set WF = Application.WorksheetFunction
Sheets("Adatok").Activate
v$ = "C"
If v$ = "B" Or v$ = "b" Then
Set WS = Sheets("Munka2")
oszlop = 2
v$ = "AF230"
GoTo Keres
End If
If v$ = "C" Or v$ = "c" Then
Set WS = Sheets("Munka1")
oszlop = 3
v$ = "AF0230M01SP1-Station2"
GoTo Keres
End If
Exit Sub
Keres:
usor = WF.CountA(Columns(oszlop))
f = False
For sor = 1 To usor
If Cells(sor, oszlop) = v$ Then
If WS.Range("C6") = "" Then sor1 = 6 Else sor1 = WS.Range("C" & Rows.Count).End(xlUp).Row + 1
Cells(sor, "D").Copy WS.Cells(sor1, "C")
f = True
End If
Next
'Rendezés
WS.Activate
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Adatok").Activate
Application.ScreenUpdating = True
End Sub"Az élet olyan mint az ásás. Néha pár gyökér feltart, de annak jól odacsapsz és mehetsz tovább!"
-
tgumis
tag
válasz Delila_1 #20210 üzenetére
Köszi a választ de abszolút semmi t nem értek belőle. Bocs de akárhogy is olvasgatom a fórumot sehogy nem történik semmi.Ez amit leírtál visual basic kód? Azzal mit kel csinálni?
példán keresztül bemutatnád?
A1 kék
A2 lapát
A3 nyéll
A4 papám kertjétA5 én kék lapát nyéllel ástam a papám kertjét
="én "&A1&" "&A2&" "&A3&"el ástam a "&A4
hogyan tudom a kék szót kékké a lapát nyél-t és a el-t félkövérré (nyéllel lesz belőle összefűzés után)[ Szerkesztve ]
-
tgumis
tag
válasz Delila_1 #20220 üzenetére
Megpróbáltam de nem müxik
Létrehoztam egy segédtáblát oda irányitott beillesztéssel átmásoltam mindent de ahogy kész voltam és mindent f_án megformáztam rögzítés vége. Majd új adatokkal feltöltöttem a táblázatot elindítottam a makrót és semmi nem történt maradt az előbb kitöltött adatokkal -
earth
csendes tag
válasz Delila_1 #20218 üzenetére
Hello.
Köszönöm a válaszod, de én több száz vagy ezer számról beszélek és nem szeretném megszámolni mennyi hasonló van én azt szeretném hogy ezt a program megcsinálja maga. Az első lapon van kb több ezer termékkód egymás alatt amit egy cégtől kaptam, a második lapon pedig azok a termékkódok amiket mi szoktunk rendelni ugyanattól a cégtől de még nehezíti a feladatot hogy teljesen különböző sorrendben. És azt szeretném hogy ami az első lapon megegyezik a második lapon lévővel azt tegye a harmadik lapra.
Köszönöm.
-
Térközjelző
csendes tag
válasz Delila_1 #20250 üzenetére
Szia!
Köszönöm, hogy megnézed:
2014-Utazás tábla: ide kellene raknom az eredményt.
és
menetrend.xls tábla ebben kell keresgélni:
Közben érkezett a hír, hogy 1szerűbb lett a tábla, mert csak a közlekedő járatokat tartalmazza, nem kell foglalkozni vele, hogy egy járat épp adott napon megy-e.
Az aktuális remélhetőleg végleges verzio:A táblák azonos könyvárban vannak a számítógépen.
Remélem sikerült minden értelmesen leírnom. Ha mégsem kérlek kérdezősködj.Köszönöm szépen!
-
Térközjelző
csendes tag
válasz Delila_1 #20262 üzenetére
Szia!
Nagyon jó irányba halad a tábla, köszönöm a rengeteg segítséget.
Talán az elnevezés pontatlan, de az Utazás táblában a szolgálati lap száma D oszlop NEM a vonal számát jelenti, az csupán egy futó sorszám pl iktatószám. A Vonal számát CSAK a Menetrend pirosan jelzett cellája adja. Érdemes lehet kihámozni a Járatok lapra.
Még egy szabály eszembe jutott:
Akkor talán nem kell ennyi tartomány minden egyes járatnak. A járat típusok azt jelölik, hogy a járat milyen megállókon áll meg, lehet elég lenne csak azokat elnevezni, és abban tárolni a rá jellemző útvonalat.
ALL: köszönöm mindenkinek aki egyáltalán elgondolkodott a feladaton. Kihívásnak tuti nem rossz. )
Köszönöm!
-
AtHoS
nagyúr
válasz Delila_1 #20287 üzenetére
Köszi
Ez egy elegáns megoldás. Kár, hogy nem jutott eszembe
Közben megoldottam amúgy egy bonyolultabb módszerrel
2 új oszlop a B elé, ezeket formáztam dátumra, majd rendeztem a B oszlopot, így a végére kerültek a 2014-esek. A létrehozott C oszlop celláiba "=D1-365", ahol ugye a * folyamatosan nő a soroknak megfelelően, majd a C oszlop másol, B oszlopba irányított beillesztés -> érték, majd a C és D oszlop töröl és voálá.
Ehhez képest a csere azért jóval elegánsabb
read-only mode on the forum
-
deka1
csendes tag
válasz Delila_1 #20291 üzenetére
Szia,
köszi, >"" helyett >0 lett a jó:
=HA(A2>0;SZÖVEG(A2;"éééé.hh.nn");"") & HA(B2>0;KARAKTER(10) & SZÖVEG(B2;"éééé.hh.nn");"")Bár ha az első (második, harmadik) oszlop sorában nem szerepel dátum, az új cellában is létrehoz 1 db üres sort legfelülre...
[ Szerkesztve ]
-
Attas
aktív tag
válasz Delila_1 #20339 üzenetére
Ez vajon miért nem működik újfent?
Option Explicit
Sub TípusVálasztás()
Dim WÜM As Worksheet
Set WÜM = Sheets("Ütemidő műveletenként")
WÜM.Select
If WÜM.Cells(13, "C") = "x" Then UserForm1.Controls("AF10") = True Else UserForm1.Controls("AF10") = False
If WÜM.Cells(13, "D") = "x" Then UserForm1.Controls("AF20") = True Else UserForm1.Controls("AF20") = False
If WÜM.Cells(13, "E") = "x" Then UserForm1.Controls("AF30") = True Else UserForm1.Controls("AF30") = False
If WÜM.Cells(13, "F") = "x" Then UserForm1.Controls("AF40") = True Else UserForm1.Controls("AF40") = False
If WÜM.Cells(13, "G") = "x" Then UserForm1.Controls("AF50") = True Else UserForm1.Controls("AF50") = False
If WÜM.Cells(13, "H") = "x" Then UserForm1.Controls("AF60") = True Else UserForm1.Controls("AF60") = False
If WÜM.Cells(13, "I") = "x" Then UserForm1.Controls("AF70") = True Else UserForm1.Controls("AF70") = False
If WÜM.Cells(13, "J") = "x" Then UserForm1.Controls("AF90") = True Else UserForm1.Controls("AF90") = False
If WÜM.Cells(13, "K") = "x" Then UserForm1.Controls("AF100") = True Else UserForm1.Controls("AF100") = False
If WÜM.Cells(13, "L") = "x" Then UserForm1.Controls("AF110") = True Else UserForm1.Controls("AF110") = False
If WÜM.Cells(13, "M") = "x" Then UserForm1.Controls("AF120") = True Else UserForm1.Controls("AF120") = False
If WÜM.Cells(13, "N") = "x" Then UserForm1.Controls("AF130") = True Else UserForm1.Controls("AF130") = False
If WÜM.Cells(13, "O") = "x" Then UserForm1.Controls("AF140") = True Else UserForm1.Controls("AF140") = False
If WÜM.Cells(13, "P") = "x" Then UserForm1.Controls("AF150") = True Else UserForm1.Controls("AF150") = False
If WÜM.Cells(13, "Q") = "x" Then UserForm1.Controls("AF160") = True Else UserForm1.Controls("AF160") = False
If WÜM.Cells(13, "R") = "x" Then UserForm1.Controls("AF180") = True Else UserForm1.Controls("AF180") = False
If WÜM.Cells(13, "S") = "x" Then UserForm1.Controls("AF210") = True Else UserForm1.Controls("AF210") = False
If WÜM.Cells(13, "T") = "x" Then UserForm1.Controls("AF215") = True Else UserForm1.Controls("AF215") = False
If WÜM.Cells(13, "U") = "x" Then UserForm1.Controls("AF216") = True Else UserForm1.Controls("AF216") = False
If WÜM.Cells(13, "V") = "x" Then UserForm1.Controls("AF220") = True Else UserForm1.Controls("AF220") = False
UserForm1.ListBox1.List = WÜM.Range("CellTípusok").Value
UserForm1.Show
End SubEddig működött amíg a rövidítést nem alkalmaztam
Hibaüzenet " Method of 'range' of object'_Worksheet' failed[ Szerkesztve ]
"Az élet olyan mint az ásás. Néha pár gyökér feltart, de annak jól odacsapsz és mehetsz tovább!"
-
bteebi
veterán
válasz Delila_1 #20333 üzenetére
Szia!
Nagyon köszönöm a segítséget , egyelőre azonban valamiért még nem működik a kód. Azt írja, hogy a Range osztály Select metódusa hibás.
Valamennyit javult a makróm, de ha az
If Target.Address = "$A$1" Then
sor volt megadva, akkor nem működött. Csak akkor futott le magától, ha a lentebb látható módon próbáltam:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Sheets("Suzuki").PageSetup.CenterHeader = "Szín: " & Sheets("Lista").Range("A1").Value
'és ez a sor ismételve az összes lapra, de az elég gagyi
Application.EnableEvents = True
End SubEzt viszont nem tudtam úgy átírni eddig, hogy működjön. Pedig az ötleted tök jó, de valamiért nem megy. Kipróbáltam egy M$ honlapon lévő makrót is, de nem tudtam úgy átírni, hogy jó legyen (mondjuk az az összes lapra működne elvben, úgyhogy a te megoldásod jobb lenne):
Sub WorksheetLoop2()
Dim Current As Worksheet
For Each Current In Worksheets' Insert your code here.
Next
End SubDe ezt se tudtam úgy átírni, hogy működjön . Ilyet próbáltam:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim Current As Worksheet
For Each Current In Worksheets
.PageSetup.CenterHeader = "Szín: " & Sheets("Lista").Range("A1").Value
'ez így hibás, valahogy máshogy kellene megadni, de ActiveSheet-tel se megy
Next
Application.EnableEvents = True
End SubVan ötleted, hogy mi lehet a probléma?
[ Szerkesztve ]
Cancel all my meetings. Someone is wrong on the Internet.
-
Attas
aktív tag
-
bteebi
veterán
válasz Delila_1 #20343 üzenetére
Működik! Hálás köszönet érte!
Igazából úgy is megy, ahogy először leírtad, valamit én ronthattam el.
Már csak egy dolgot nem értek: csak úgy működik, ha a Target.Address abszolút hivatkozással van megadva, tehát "$A$1". Se úgy nem megy, hogy "A1", se úgy, hogy Me.Range("A1"), és úgy se, hogy Sheets("Lista").Range("A1"). Nem kellene egyébként mindig lefutnia a makrónak, ha bármelyik lapon változik az A1-es cella? Nem teszi (és nekem így jó), de valahol logikusnak tűnne, mert elvileg akkor le kellene futnia, ha az A1-es cella változik. Vagy a private sub-ban lévő abszolút hivatkozás csak az adott lapon érvényes? (Igen, jól gondolod, sajnos nem értek hozzá .)
Cancel all my meetings. Someone is wrong on the Internet.
-
Attas
aktív tag
válasz Delila_1 #20361 üzenetére
Köszönöm A segedelmet!
Majdnem így jártam el. Ha hibásan fut le a számítás egy cellába 1-est írok. A főágba tettem egy if-et, Ha 1-es a tartalma eme cellának akkor goto végére és exit sub."Az élet olyan mint az ásás. Néha pár gyökér feltart, de annak jól odacsapsz és mehetsz tovább!"
-
Salex1
senior tag
válasz Delila_1 #20359 üzenetére
Köszi! kicsit átalakítva tudtam csak működésre bírni, biztos van egyszerűbb mód, de legalább működik.
Range("K1").Value = ActiveSheet.Shapes("Text Box 558").TextFrame.Characters.Text
Range("L1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(""*"",RC[-1],""*"")"
Selection.AutoFilter Field:=2, Criteria1:=Range("L1").TextLehetséges valahogy a makrót hozzárendelni a textbox elhagyásához, vagy a textboxban az enter megnyomásához?
[ Szerkesztve ]
-
psg5
veterán
válasz Delila_1 #20396 üzenetére
Összefoglalva:
Tökéletesen működik.
Kijavítottam xlxs-et sima xlx-re, így már megnyitható.Akkor ami kérdés még vissza lenne:
1. Első két sor is fixen kellene az eredetiből.
2. mentési név az egyik oszlopban szereplő számok, eléjük egy nullát írva. (A oszlopból lennének a mentési elnevezések)SZERKESZTVE:Közben olvasom a válaszaidat, így már csak a 2. kérdés van vissza
Köszi!
[ Szerkesztve ]
F.K.T.
-
psg5
veterán
válasz Delila_1 #20404 üzenetére
Tényleg nem direkt nem írtam le hamarabb. Sorry.
xls-et természetesen elírtam a nagy kapkodásban ami azért történt, mert nagyon kész akartam vele lenni, annyira felcsigázott, hogy van megoldásNagyon-nagyon hálás vagyok a segítségért!
Még annyi, hogy ezzel az utolsó javítással csupán egy "0" elnevezésű fájlt hoz létre.
valamit rosszul írhattam?[ Szerkesztve ]
F.K.T.
Új hozzászólás Aktív témák
- Amlogic S905, S912 processzoros készülékek
- NVIDIA GeForce RTX 4080 /4080S / 4090 (AD103 / 102)
- ThinkPad (NEM IdeaPad)
- Linux - haladóknak
- Milyen billentyűzetet vegyek?
- Autós topik látogatók beszélgetős, offolós topikja
- antikomcsi: Való Világ: A piszkos 12 - VV12 - Való Világ 12
- Hálózati / IP kamera
- Vallás
- ArmA 3 - This Is War
- További aktív témák...
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs