- Több tucat gyorsító összeköthetőségét kínálja az Instinct MI400 sorozat
- Imádja az alteregókat az új AMD Software
- Csak úgy szórja a dollár milliárdokat adatközpontokra az Amazon
- Mexikó tisztázta a Google-t a monopóliummal kapcsolatos vádak alól
- Egyre csak fejlődik az AI, emberek tízezreit rúgja majd ki a BT
- Milyen egeret válasszak?
- Milyen monitort vegyek?
- Házimozi belépő szinten
- Milyen belső merevlemezt vegyek?
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Samsung LCD és LED TV-k
- Milyen billentyűzetet vegyek?
- OLED monitor topik
- Azonnali alaplapos kérdések órája
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
Új hozzászólás Aktív témák
-
smallmer
őstag
Sziasztok!
Makrót szeretnék készíteni a következő feladat megoldására:
Van kb. 200 darab excel fájlom.
Minden fájlban van 4 darab munkalap.
Minden munkalapon Vannak adatok kb 150 oszlop és 220 sor, de pár darabbal lehet több.A feladat az lenne, hogy van egy SABLON fájlom, amiben már van egy kész macro, ami arra szolgál hogy valamilyen szempont alapján vizsgálja a 4 munkalap adatait.
Ebbe a sablonba kellene mind a 200 daran excel fájl adatait egyesével belerakni, majd elmenteni, és az se lenne rossz, ha a sablon macroja lefutna. Ezt valahogyan meg lehet oldani automatizáltan?
Programozáshoz az alapokat értem(java,c++ ...)Köszönöm szépen
-
-
vilag
tag
Sziasztok!
Lenne egy fontos és sürgős kérdésem:
Tudok-e VBA-ban "öngyilkos kódot" írni?
A lényege az lenne, hogy ha valaki a Projektet védő kódot mondjuk 3-szor rosszul üti be (VBAProject - Project Properties/Protection), akkor az azt eredményezi, hogy a projektből az összes kód törlődik és ráment a munkafüzetre.
Úgy néz ki elhagyom a jelenlegi munkahelyemet és a programokat ugyan itt hagyom, használhatják, de nem akarom, hogy a kódhoz bárki is hozzábabráljon (mégis csak az én "gyermekem").
Továbbá érdekelne, hogy hogyan is kell levédetni jogilag egy programot.
Mivel már csak korlátozottan fogok hozzáférni a gépemhez, nagyon sürgős lenne a dolog.
Köszönöm!
-
sztanozs
veterán
-
_kovi_
aktív tag
-
Ispy
nagyúr
Hát ahhoz írni kell egy win szervizt, mondjuk .NET-be, aztán telepíteni kell a szerviz modulba.
Egyébként nem egy agysebész feladat, kell hozzá egy Visual Studio, meg pár sor kód.
Mondjuk nem tudom ez mennyire jó, mert a szerviz már akkor elindul, amikor feláll a win, tehát még be sem kell hozzá loginolni, lehet jobb lenne, ha leírnád pontosan miért is kell ez.
-
bozsozso
őstag
Sziasztok,
Kis segítség kellene ami lehet nem is kicsi. Excel makróban szeretnék egy olyat megvalósítani nyomógombbal, hogy megadott könyvtárból másoljak fájlokat megadott könyvtárba az alábbi módon:
Könyvtárszerkezet:
c:\a\001\x\fájl1.exe
fájl2.exe
c:\a\002\x\fájl1.exe
fájl2.exe
fájl3.exe
c:\a\003\x\fájl1.exe
fájl3.exe
c:\a\004\x\fájl1.exe
stb.Elkezdi keresni a fájlt a könyvtárakban, nincs fix név amit talál azzal foglalkozik. Az 1-2-3-4 azok folytonos számok 999-ig de vannak kihagyások az nem tudom mennyire gond, hogy 100 alatt elő vannak nullázva(pl.:080) 3 karakterre.
Ha talált fájlt akkor egy megadott helyen létrehoz egy napi dátumos könyvtárat majd azon belül a fájl nevével megegyező könyvtárat
kiterjesztés nélkül.
Pl:c:\mappa\2018.01.11\fájl1\
Majd ide elkezdi bemásolni az 1-2-3-4 stb "x" mappában található fájlokat úgy, hogy fixnév_1.exe, fixnév_2.exe........
A végén lesz egy ilyenem:
c:\mappa\2018.01.11\fájl1\fixnév_1.exe(itt már nem kellene előnullázni a számot)
fixnév_2.exe
stb.Persze ha közben új fájlt talál akkor szintén létrehozza a hozzá tartozó könyvtárat és ha a továbbiakban talál ugyanilyet akkor azt már ebbe a
könyvtárba másolja. A mappák mindig fixek csak a fájlok mások.Hát nem tudom érthetően fogalmaztam-e, de ha valaki tud annak előre is köszönöm a segítséget.
-
vilag
tag
Valakinek van ötlete hivatkozott problémával kapcsolatban?
+1 kérdés:
Adott egy munkafüzet aminek az egyik lapját (vagy annak tartalmát) másolom egy új munkafüzetbe és mentetem el kód segítségével.
Szerencsére a munkalapon lévő gomb (és a hozzá tartozó kód is) megye vele.Meg lehet-e valahogyan oldani, hogy az újonnan létrejövő munkafüzet "ThisWorkbook"-jába kódot helyezzek el?
Oda szeretném megírni, hogy bezárás előtt ne dobjon fel hibaüzenetet, hanem mindent figyelmen kívül hagyva zárja be.
Nevezetesen:Application.Displayalerts = FalseA gombnyomásra lefutó makró miatt ugyan is bezárás előtt megkérdezi, hogy akarok-e menteni.
Ezt viszont nem szeretném, mert a felhasználók amúgy sem tudnak beleírni a munkafüzetbe, így semmi szükség erre, csak összezavarja szegényeket...Sajnos ebben a formában eredménytelen:
Private Sub CommandButton1_Click()
ActiveSheet.PrintOut Copies:=2, Collate:=True
Application.DisplayAlerts = False
End Sub -
sztanozs
veterán
Ahogy nézem SortFields-be megadott range nem lehet több oszlop széles. Vsz ez a problémája.
Ha több oszlop szerint szeretnél rendezni, akkor mindet egyesével hozzá kell adni.
Majd miután beállítottad a rendezési feltételeket, jöhet a Sort parancs.Valahogy így:
Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Sort. _
SortFields.Add Key:=Range(Range("A2:A" & s_OutRow)), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Sort.SetRange Range("A2:" & HeaderKAT_Last_Col & s_OutRow) -
Lokids
addikt
Már nem tudom szerkeszteni.
Ez nem jó.
Set WBRange = Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Range("A2:" & HeaderKAT_Last_Col & s_OutRow)
Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Sort.SortFields.Add Key:=Range(WBRange & "[" & "Projekt neve" & "]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormalEz meg miért jó?
Range("A2").Select
ActiveWorkbook.Worksheets("VIGKAT").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal -
-
Lokids
addikt
Ne ezzel mi a gond? Mi az, hogy _Global failed?
Set WBRange = Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Range("A2:" & HeaderKAT_Last_Col & s_OutRow)
Workbooks(OutputKAT_F_Name).Worksheets(s_wsName).Sort. _
SortFields.Add Key:=Range(WBRange), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal -
vilag
tag
válasz
Delila_1
#2973
üzenetére
Tökéletes!
Remekül sikerült megoldani a problémát.
Felvetnék még egy kérdést amelyre régóta nem lelem a megoldást.
Van egy olyan TextBoxom (illetve több is), amely úgy van megoldva, hogy csak számokat enged bevinni az alábbi kóddal:Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Ügyirat főszámba csak számot enged írni
If KeyCode = 8 Or KeyCode = 46 Or _
(KeyCode >= 48 And KeyCode <= 57) _
Or (KeyCode >= 96 And KeyCode <= 105) Then
TextBox1.Locked = False
Else
TextBox1.Locked = True
End If
End SubValamilyen okból ha a munkafüzetet Office 2007-ben Win7-es gépen mentem el, random módon az a jelenség következik be, hogy elindítva a formot a mezőbe nem csak számot enged írni, valamint ha nyomok egy TAB-ot akkor nem a következő vezérlőre ugrik hanem valóban egy tabulátort tesz az adott vezérlőbe.
Ez ugye hibás működést eredményez és számos problémát okoz.
Arra viszont rájöttem, hogy ha egy Win Xp-s gépen (és azt hiszem Office 2003-on) makrók letiltásával indítom a munkafüzetet és rámentek, akkor már a Win7-es Office 2007-es gépeken sem jelentkezik a probléma.
Van esetleg ötleted (vagy bárkinek), hogy mivel lehetne ezt kiküszöbölni.
Most csak ezért megint össze kellett raknom egy Xp-s gépet amit gyakorlatilag csak ennyire használok.Egy másik apró de idegesítő probléma:
A munkafüzet indításakor automatikusan indul a form. Ezen van egy gomb amely lehetővé teszi a VB indítását és ezzel együtt a jelszavazás feloldását is az alábbi módon:Unload Me
Unload UserForm1
Application.Visible = True 'hogy az Excel menüje újra látszódjon
'Project védelem feloldása
With Application
.SendKeys "%{F11}", True 'VB megnyitása
.SendKeys "^r", True 'Project Explorer ablak aktiválása
.SendKeys "SZTK" 'SZTK projectre ugrás
.SendKeys "~", True 'Enter leütés imitálása
.Wait (Now + TimeValue("0:00:01"))
.SendKeys "jelszó" 'Jelszó megadása
.SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
' .SendKeys "Mod"
' .SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
.SendKeys "For"
.SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
' .SendKeys "Mic"
' .SendKeys "~", True 'Enter leütés imitálása
End WithA folyamat végén valóban indul a VB, de valamiért a NUMLOCK-ot kikapcsolja.
Ugyan ez a fentebb említett Xp-s gépen is lefut azonban ott nem kapcsolja ki a NUMLOCK-ot.A kívánatos az utóbbi lenne.
-
vilag
tag
válasz
Delila_1
#2969
üzenetére
Ez a megoldás tényleg sokkal frappánsabb.
Apróbb kiegészítésekkel (ami nem képezte részét az eredeti koncepciónak) be is építettem.Néhány kivételkezelést tettem még hozzá, de ezek mind szépészeti beavatkozások. PL.: hogy csak olyan tartományt jelöljön ki ahol már van érték, meg a fejléces tartományban ne jelöljön ki, ilyesmi...
Köszönöm a segítséget!
-
Delila_1
veterán
A tegnapi makró egyszerűsítve úgy, hogy az összes cella háttér színezést szüntesse meg, mielőtt a kijelölt sorokat besárgítja:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim kezd As Long, ucso As Long, cim As String
Application.EnableEvents = False
Cells.Interior.Color = xlNone
cim = Target.Address
kezd = Selection.Row
ucso = Range(cim).Row + Range(cim).Rows.Count - 1
Rows(kezd & ":" & ucso).Interior.Color = vbYellow
Application.EnableEvents = True
End Sub -
#2968
csaszizoltan
csendes tag
Lokids
#2965
csaszizoltan
csendes tag
És így?
Egyébként az biztos, hogy egy szóközt egy üres stringgé kell átalakítania a replace-nek, mindenhol mindenképp az előbbi szerint próbáld.Dim s_Cell As Range
Set s_Cell = Workbooks(Input_F_Name).Worksheets(Input_KATWS_Name).Cells(p_SrcRow, s_CNum)
s_Cell.Value = Replace(s_Cell.Value, " ", "") -
#2965
Lokids
addikt
csaszizoltan
#2962
Lokids
addikt
válasz
csaszizoltan
#2962
üzenetére
De ezt próbáltam. És nem működik.
-
Lokids
addikt
Meg tudja valaki mondani, hogy tudom a szóközöket eltávolítani egy cellából.
Pl: cella értéke: 101 101 101
És ez kellene legyen: 101101101Az spacek miatt nem húzza rá a pénznem formát, így ki kéne szednem a szóközöket.
Se a trim, se a replace nem működik.
s_Cell.value = Workbooks(Input_F_Name).Worksheets(Input_KATWS_Name).Cells(p_SrcRow, s_CNum)
s_Cell.value = Replace(s_Cell, " ", " ")
s_Cell.value = WorksheetFunction.Trim(s_Cell)A google találatokban ezt a két módszert láttam megoldásra.
-
vilag
tag
válasz
Delila_1
#2959
üzenetére
Nagyon szépen köszönöm!
Kicsit egyszerűsítettem rajta mivel biztosan nem lehet a munkalapon semmi korábbi színezés, így annyit csináltam, hogy minden színezést töröl és utána színezi az érintett sorokat a módszered szerint.
Egyébként azt furcsállom, hogy a
Target.Rowsnem működik.
Pedig a Target-nek van Row és Rows tulajdonsága is, legalábbi a "." billentyű után felkínálja mint lehetőséget. -
Delila_1
veterán
Már majdnem kész volt a makró, mikor jött a szerelő.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim elozo As String, kezd As Long, ucso As Long, b As Integer, cim As String
Application.EnableEvents = False
cim = Target.Address
Debug.Print Target.Address
If Range("AA1") <> "" Then
elozo = Range("AA1") & ":" & Range("AB1")
Range(elozo).Interior.Color = xlNone
End If
kezd = Selection.Row
For b = Len(cim) To 1 Step -1
If Mid(cim, b, 1) = "$" Then
ucso = Mid(cim, b + 1, 20) * 1
Exit For
End If
Next
Rows(kezd & ":" & ucso).Interior.Color = vbYellow
Range("AA1") = kezd: Range("AB1") = ucso
Application.EnableEvents = True
End SubItt a kijelölés alsó sorát egy ciklussal kerestetem ki. Ha sikerül elegánsabb megoldást találni rá, megírom.
-
vilag
tag
válasz
Delila_1
#2957
üzenetére
A
Target.Row-t már próbáltam, de az csak a kijelölt tartomány első sorának sorszámát adja vissza lekérdezésben.A
Rows(Target.Row).Interior.Color = vbYellowpedig ugyan megtartja az eredeti kijelölést, de csak a kijelölt tartomány első sorát színezi át.Tehát még mindig az a probléma, hogy hogyan lehetne lekérdezni a kijelölt tartománnyal érintett sorokat?
A
x=Targer.Addressvisszaadja a teljes tartományt, de abból meg ki kellene mókázni a sorok számát...Ezért valami ettől egyszerűbb megoldást keresek.
-
-
vilag
tag
válasz
Delila_1
#2955
üzenetére
Ez eddig rendben van, ezt én is megoldottam (ugyan ennél kevésbé elegánsabban), de egy fontos körülmény elkerülte a figyelmedet:
Én nem magát a kijelölt területet akarom átszínezni, hanem a kijelölt területtel érintett egész sorokat.
Az egésznek a lényege az lenne, hogy amolyan sorvezetőként szolgálna a szemnek.
De lehet, hogy az általad írt kódból is meg tudom oldani a dolgot, mert most kipattant egy ötlet a fejemből, meglátjuk működik-e.
-
Delila_1
veterán
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim elozo As String
Range(Target.Address).Interior.Color = vbYellow
If Range("AA1") <> "" Then
elozo = Range("AA1").Value
Range(elozo).Interior.Color = xlNone
End If
Range("AA1") = Target.Address
End SubSzínezi a kiválasztott területet, majd az AA1-be beírja a jelenlegi területet. A következő kijelölésnél a színezésen kívül az AA1-ben tárolt cím (terület) színezését megszünteti.
-
vilag
tag
válasz
Delila_1
#2953
üzenetére
Köszönöm a javaslatot.
Ma már kínlódtam vele vagy két óra hosszát, de belekavarodom a dologba és most teljesen máshogy akarom újra kezdeni.
Most épp látom a fényt az alagút végén, de csak pislákol.
A javaslatodat használva próbálkoztam, de nem teljesen hozza a várt eredményt.
Jelen formájában kiszínezi a kijelölt cellát vagy cellákat, azonban ha újabb cellát vagy cellákat jelölök ki akkor azokat is kiszínezi (az elősző színezések meghagyásával).A célom az lenne, hogy a kijelölt cellák sorait jelölje ki és az esetlegesen korábban kijelölt cella/cellák sorainak színezését pedig szüntesse meg.
A fejemben már össze is állta a dolog el is kezdtem megírni, de ott elakadtam, hogy több sort érintő kijelölés esetén csak az első sor sorának a számát tudom lekérdezni pl ezzel
sorok = Selection.Row
pedig nekem a kijelölés kezdő és végsorának számára is szükségem lenne.Próbáltam
Selection.Addresskóddal is de abból meg csak kerülő úton tudnám a sorok számát kinyerni.Van esetleg erre valami egyszerűbb megoldás?
Egyébként nagyjából így képzelném a kódot:
Cells.Interior.Pattern = xlNone 'összes színezés megszüntetése a munkalapon
kijelolttartomanysorai = ????
Rows(kijelolttartomanysorai).Interior.Color = vbYellowÍgy visszanézve kissé viccel, hogy egy 3 soros kóddal bajlódom két órája
-
Delila_1
veterán
Lapfülön jobb klikk, Kód megjelenítése.
Ezzel beléptél a Visual Basik-be, ott is a lapod kódjához. A jobb oldalon lévő nagy üres felületre viheted be az eseményvezérelt makrót. Az üres rész tetején balra a (General) helyett kiválasztod a Worksheet opciót.
Már meg is jelent a makród kezdő- és befejező sora.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End SubEz a makró akkor indul, ha egy cellát kiválasztasz, magyarul, ha rálépsz. A két sor közé írhatod meg a kódodat, pl.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Interior.Color = vbYellow
End SubA kiválasztott cella háttere sárga lesz.
Adhatsz feltételt, hogy pl. csak az A oszlopban sárgítson.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Target.Interior.Color = vbYellow
End If
End SubEzernyi más dolgot is rendelhetsz a makróhoz.
-
vilag
tag
Halihó!
Azt meg lehet valahogyan oldani, hogy ha kijelölök egy cellát akkor az adott sor háttere színt váltson?
Próbáltam a Workbook_Change()-ben megírni, de úgy tűnik, hogy a kijelölt cella változásakor a Workbook_Change () nem fut le.
Igazándiból nem is arra vagyok elsősorban kíváncsi, hogy mit írjak meg (bár erre is szívesen fogadok javaslatokat, hátha valakinek jobb ötlete van mint nekem), hanem sokkal inkább az, hogy hová kellene azt megírni.
Köszönöm!
-
Lokids
addikt
válasz
Delila_1
#2950
üzenetére
Azt hiszem megvan a hiba.
Van a fenti részben egy feltétel. "If actrow = 2 then"
Na ide nem lép be, hogyha a fenti rész lefut. Ezért kiakad a második résznél.
Azt az If-et a Range léptetés elé téve működik.
De jellemző, hogy az után veszem észre, hogy felteszem a kérdést. Nem az előtte lévő 1 órában.
-
Delila_1
veterán
Valahol elvész a változó értéke. Lépésenként futtatva megtalálod az eltűnés helyét. Valószínűleg nem publikusként deklaráltad a változó(ka)t, vagy a 2. makró meghívásánál elmulasztottad a változó(k) átadását.
Ha "Konkrétan az mindig "A" lesz.", akkor miért teszed változóba, mikor fixen is megadhatnád, és nem foglalnád vele a memóriában a helyet?
-
Lokids
addikt
Sziasztok!
Miért lehet az, hogy 2 látszólag egymástól független range változó Subscript out of range hibát okoz?
Set s_PrjRng = Workbooks(Main_WB_Name).Worksheets(KAT_WB_Projects_Sheet).Range(NotNeeded_Prj_Name)
For actRow = 2 To 95 'InputTRows
s_PrjName = Workbooks(Input_F_Name).Worksheets(Input_KATWS_Name).Cells(actRow, ColumnLetterToNumber(Data_KAT_Projname))
For Each s_prng In s_PrjRng 'Workbooks(Main_WB_Name).Worksheets(KAT_WB_Projects_Sheet).Range(NotNeeded_Prj_Name)
If s_PrjName = s_prng.value Then
i = i + 1
End If
Next s_prng
s_Status = Workbooks(Input_F_Name).Worksheets(Input_KATWS_Name).Cells(actRow, ColumnLetterToNumber(Data_KAT_Stat))
If (s_Status <> "5 - Lezárt") And (s_Status <> "4 - Zárás") And (i = 1) Then
If actRow = 2 Then
Workbooks(OutputKAT_F_Name).Worksheets(1).Name = Left(s_wsName, 31) '2017.09.26
Write_Header5 OutputKAT_F_Name, s_wsName
End If
CopyRow OutputKAT_F_Name, s_wsName, s_OutRow, actRow
s_OutRow = s_OutRow + 1
End If
i = 1
Next actRowEz meghívja a CopyRow-ot, amin belül pedig van egy ilyen rész:
Set s_RowRange = Workbooks(p_WB).Worksheets(p_WS).Range(HeaderKAT_Frst_Col & p_Row & ":" & HeaderKAT_Last_Col & p_Row)
For Each s_Cell In s_RowRange
s_CNum = Workbooks(Main_WB_Name).Worksheets(KAT_WB_Head_Sheet).Cells(4, s_Cell.Column)Ez utóbbi jól működött egészen addig, amíg a fenti Range bele nem került. Most a Set s_RowRange sornál hibát dob.
És nem értem miért.
-
vilag
tag
-
vilag
tag
válasz
Delila_1
#2941
üzenetére
Pedig ha megnyitom a cellaformázás menüt akkor az van a "Szám" fülön, hogy "Dátum", típus: "*2001.03.14"
Ezért utálom én az excel dátumkezelését, mert gyakran még maga sem tudja, hogy mi micsoda.
Most pedig megpróbálom befejezni a kódot.
Még egyszer nagyon köszönöm!
Ma ismét tanultam valamit. -
vilag
tag
válasz
Delila_1
#2939
üzenetére
x = Application.WorksheetFunction.VLookup(atvdatuma * 1, ThisWorkbook.Sheets("Jogerő").Range("a:c"), 3, 0)Így működik
Utálom az excel dátumkezelését, és továbbra sem értem, hogy miért működik ha 1-el megszorzom.... de működik és most csak ez számít, remélem így már be tudom fejezni a kódot.
-
vilag
tag
válasz
Delila_1
#2937
üzenetére
=FKERES(P7241;Jogerő!A:C;3;0)#HIÁNYZIK hibára fut.
=FKERES(ÉRTÉK(P7241);Jogerő!A:C;3;0)Így viszont eredményes.
Viszont ha a kódot kiegészítem ezzel:
atvdatuma = Val(atvdatuma)akkor a atvdatuma = 2017,11 lesz, nem pedig dátumérték
Ebbe az irányba már próbáltam korábban elmenni, de ugyan ide lyukadtam ki.
Pedig szinte biztos vagyok benne, hogy ez lenne a megoldás kulcsa. -
vilag
tag
válasz
Delila_1
#2935
üzenetére
Megcsináltam, végigléptettem, de ugyan az az eredmény mint korábban
Az utolsó sorban hibára fut.
Nem lehet, hogy az a baj, hogy amikor az atvdatuma változó felveszi az értéket az így néz ki:
atvdatuma = 2017.12.04.
Azaz idézőjelek nélkül és a nap után ponttal, a dátumos cellákban meg ugye idézőjelekkel és a nap után pont nélkül szerepelnek a dátumok.
Nem lehet, hogy ez okozza a problémát?
-
Delila_1
veterán
A különbség az, hogy a szintaktika szerint & jelet kell alkalmazni, a + jel értelmetlen.
Csináld a következőt: írj be egy üres cellába egy egyest. Másold Ctrl+c-vel. Jelöld ki a dátumokat tartalmazó cellákat, majd Irányított beillesztés, értéket, a művelet pedig szorzás. Mindegyik dátumos tartományodra végezd el, akkor biztosan egyforma típusúak lesznek az adatok.
-
vilag
tag
válasz
Delila_1
#2933
üzenetére
Igen a jogerő lap A oszlopában vannak a dátumok amik között keresnie kellene.
A Trim(Str())-re azért volt szükség mert különben Run-time error '13': Type mismatch hibára futott.
Azonban most, hogy a + jeleket lecseréltem & jelre, úgy látom már semmi szükség rá, mert így enélkül sem fut a fenti hibára.
Még mindig kíváncsi lennék, hogy mi a különbség a + jel és az & jel között.
Gyakorlatilag egy sima fkeres függvényt akarok VBA-ban megcsinálni.
A tartomány az alábbi képen:
A fenti képen látható dátumok is dátumként formázott cellákban vannak.
-
-
-
vilag
tag
Halihó!
Régen jártam erre, egy jó ideje nem volt időm VBA-val foglalkozni.
Most azonban szakítottam rá, de viszonylag hamar bele is futottam egy triviális bár számomra jelenleg megoldhatatlan problémába.
Állandóan bajban vagyok az excel és a VBA dátumkezelésével és ez újra és újra nehézségeket okoz.Most az alábbi problémával szembesültem:
Egy cellában dátumként tárolt dátumhoz tartozó másik dátumot szeretnék eredményül kapni egy dátumokat tartalmazó tömbből vlookup függvény segítségével.Eddig jutottam:
Private Sub CommandButton5_Click() 'adott sor jogerejének kiszámolása
aktivsor = ActiveCell.Row
aktivsor = Trim(Str(aktivsor))
If Range("m" + aktivsor) = "HIV" And Range("p" + aktivsor) = "" Then
uzenet = MsgBox("Nincs átvételi esemény, nem lehet jogerősíteni", 0, "Hiba") 'ideiglenes
Exit Sub
Else
If Range("q" + aktivsor) <> "nem kereste" And Range("q" + aktivsor) <> "elköltözött" And Range("q" + aktivsor) <> "címzett ismeretlen" Then
'dátum plusz 15 nap
atvdatuma = DateValue(Range("p" + aktivsor)) + 15
'atvdatuma = Trim(Str(atvdatuma))
'y = ThisWorkbook.Sheets("Jogerő").Range("a25")
x = Application.WorksheetFunction.VLookup(atvdatuma, ThisWorkbook.Sheets("Jogerő").Range("a:c"), 3, 0)
(...)Sajnos azonban az beillesztett utolsó sornál az alábbi hibaüzenetre futok:
Run-time error '1004':
Application-definied or object-definied errorMár minden általam ismert lehetséges módon próbáltam javítani, de nem sikerül.
Van valakinek ötlete mi lehet a hiba?
Előre is köszönöm!
-
zakoss
tag
Sziasztok, az alábbi hibával fordulnék segítségért hozzátok:
A hibajelenség az hogy amikor a Login gombomra kattintok az alábbi hibaüzenettel elszáll a programom. Valami adatbáziskapcsolat gondja lehet, eddig működött, de valamiért nem akarja rendesen feltölteni a formon az adatpert értékét.
Az adatbázisban ezek vannak:
A login form pedig a user / password megadása után végigzongoráz a táblán és megnézi hogy a felhasználó név és jelszó páros stimmel-e.Bármilyen segítséget előre is köszönök.
-
LeG3Nd
tag
Sziasztok!
Olyan problémába futottam amihez egyedül már kevés vagyok
A dolgokat máshogy neveztem el nehogy a munkahelyen gondok legyenek.Tegyük fel hogy van egy cukorgyár, ami többféle cukorkát gyárt. Mindegyikhez csak egy recept tartozik, azonban ezeken a recepteken néha módosítanak. A cukorkákat gyártó gépekhez tartozik műveleti utasítás, hogyan és mit kell beállítani hogy épp az adott fajtát tudja gyártani. Tehát egy gép több fajtát tud gyártani, igénytől függően. Nevezzük ezt szériának, tehát egy adott fajta cukorkából egy gép által gyártott darabok, a gép következő fajtára történő átállításáig. Minden géphez tartozik egy minőségbiztosítási jegyzőkönyv is.
A recept, gyártási utasítás, minőség jegyzőkönyv külön fájl, utóbiból szériánként készül egy darab, illetve a recep, műveleti utasítás is módosul néha. Ezek a fájlok egy könyvtárban vannak, ömlesztve, viszont szabályos elnevezéssel, ezért a név alapján pontosan be lehet őket azonosítani. Ez így néz ki:
AAAA_BBBB_CCCC_DDDDDD.***, ahol:
AAAA: sorszám
BBBB: gyártás helye
CCCC: dokumentum típusa
DDDDDD: dokumentum kelteEzek a könnyebb kereshetőségért egy táblázatba vannak foglalva:
A feladatom az, hogy egy olyan táblát csináljak, ami mást nem tartalmaz csak egy párbeszédpanelt, ahova az adott termék azonosítóját beírva, majd a dokumentum fajtáját és a gyártás helyét (gépet) kiválasztva a legkésőbbi dátummal rendelkezőt megkeresi, és az alsó szövegdobozba mint link elhelyezi. Recept esetén természetesen nem választható a gyártás helye.
A termékhez tartozó dokumentumok azonosítása a 4 jegyű sorszám alapján történik, azonban a párbeszédablakban az azonosító alapján kell keresni, ami nem feltétlenül csak 4 számjegy, lehet szöveges is. Ezt megoldani van egy másik munkalap, ami a 4 jegyű sorszámhoz tartozó azonosítókat tartalmazza.
Ha jól sejtem ez már csak VBA-val megvalósítható feladat, amivel MsgBox-on kívül sok dolgot nem tudok alkotni, azért kérem a segítségetek.
-
martonx
veterán
-
-
prodrakan
csendes újonc
válasz
Delila_1
#2911
üzenetére
Elkezdtem tesztelgetni élesbe már az én Exceljeimmel.
Az egyik Excel-el jól működik azaz az Excel1 és Excel2-őt sikerült összhangba hozni,de nálam másképp van nyilván elnevezve,de valami baja van a harmadik Excel-el azaz legyen Excel3-al.
Valamiért ezzel a sorral van baja:
TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Planner").Columns(1), 0)Üdv,
Laci -
Delila_1
veterán
válasz
prodrakan
#2914
üzenetére
A makrót írd át.
Sub Parosit()
Dim usor As Long, sor As Long, utvonal As String
Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook
Dim WF As WorksheetFunction, TalalSor As Long
Dim kezd As Long, vegez As Long
Set WB1 = Workbooks("Excel1.xlsm")
Set WF = Application.WorksheetFunction
utvonal = "F:\Eadat\Excel fórumok\PH\"
kezd = Application.InputBox("Add meg a kezdő hét sorszámát", "Kezdő hét", , , , , , 1)
vegez = Application.InputBox("Add meg a záró hét sorszámát", "Záró hét", , , , , , 1)
kezd = WF.Match(kezd, Columns(2), 0)
vegez = WF.Match(vegez, Columns(2), 1)
Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False
usor = WB1.Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
'Excel2-ből I oszlop az Excel1 G-be
Workbooks.Open Filename:=utvonal & "Excel2.xlsx"
Set WB2 = Workbooks("Excel2.xlsx")
WB1.Activate
For sor = kezd To vegez
If Cells(sor, "G") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "G") = WB2.Sheets("Munka1").Cells(TalalSor, "I")
End If
If Cells(sor, "J") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "J") = WB2.Sheets("Munka1").Cells(TalalSor, "J")
End If
Next
WB2.Close False
'Excel3-ból I oszlop az Excel1 K-ba
Workbooks.Open Filename:=utvonal & "Excel3.xlsx"
Set WB3 = Workbooks("Excel3.xlsx")
WB1.Activate
For sor = kezd To vegez
If Cells(sor, "K") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Munka1").Columns(1), 0)
Cells(sor, "K") = WB3.Sheets("Munka1").Cells(TalalSor, "I")
End If
Next
WB3.Close False
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub -
prodrakan
csendes újonc
válasz
Delila_1
#2913
üzenetére
Na most úgy néz ki,hogy tök szuper lett!!!!
Extraként olyat meg lehet neki adni,hogy melyik héttel kezdje az ellenőrzést?
Tehát minden maradna,ahogy most van csak felugrana egy ablak,ahol megkérdezné melyik héttel kezdjek.
Az Excel1-ben a "B"-oszlopban 1-52.-ig lennének számok és azt szeretném,ha feljönne egy kérdés ahol lenyíló füllel kiválasztható lenne tól-ig meddig futtasa végig az ellenőrzést majd a felugrott ablakon belül egy INDÍT gomb megnyomásával a makró végigfutna.Ha ez nem fér bele az sem gond,mert már így is tök szuper,de akkor lenne igazán tökéletes.
-
Delila_1
veterán
válasz
prodrakan
#2912
üzenetére
Annál a módszernél, amit írtál (első üres sortól kezdje bemásolni a másik 2 fájlból az adatokat), túl sok a hibalehetőség. Most megírtam úgy, hogy az első adattól, a 4. sortól fusson végig egy For-Next ciklussal addig a sorig, ahol az A oszlopban megtalálja az utolsó adatot.
Az útvonal értékét a makró 10. sorában kell átírni, és esetlegesen új értéket adni neki a 36. sor előtt.
-
prodrakan
csendes újonc
válasz
Delila_1
#2911
üzenetére
Szia!
Csatoltam egy képet amin bejelöltem hol van a gond.
Amúgy a pirossal jelölt szakaszokon kívül bárhonnan kitörlök azt tök jól betölti!
,kivétel ha a piros kereten belül bármelyik cellából hiányzik adat a G;J;K valamelyikéből.Kipróbáltam a munkahelyi és az otthoni gépen is,ugyanaz a hiba.
-
prodrakan
csendes újonc
válasz
Delila_1
#2909
üzenetére
Na tesztelgettem és alapvetően tök szuper viszont a befagyás ennél is megvan.
Azt vettem észre,hogy ha az utolsó vagy utolsó előtti sorból kitörlök és elindítom a makrót akkor lefagy az egész Excel.
Tehát,ha az Excel1 "G" & "J" & "K" oszlopok bármelyikéből kitörlöm az utolsó vagy utolsó előtti sort akkor lefagy.
A fentieken kívül ugyanez a helyzet az Excel1 15.-ik sorától felfele vagyis,ha a "G" & "J" & "K" oszlopok 13. vagy 14.-sorból hiányzik adat akkor szintén lefagy.
Az összes többi területen nem produkálja a hibát max.,ha a Excel1 "G" & "J" & "K" oszlopok teljes tartalmát kitörlöm. -
prodrakan
csendes újonc
válasz
Delila_1
#2907
üzenetére
Köszönöm!
Annyi hibát észleltem amúgy,hogyha az Excel1 "G" oszlopába a "Zöldség" megnevezésen kívül mindent kitörlök akkor valamiért nem csinálja meg és befagy.
A többi oszlopba is ezen az elven kell dolgoznia a makrónak.
AZ "A"-oszlop a fő szempont a többinél is annyi a változás,hogy az Excel1-ben ugyan ezt a feltételt futtassa le csak több oszlopot kell figyelnie azaz:
Az Excel1-ben van "A" & "G" & "J" & "K" oszlopok
Az Excel2-ben van "A" & "I" & "J" oszlopok
És van egy Excel3 amiben van "A" & "I" oszlopokAz Excel1 "A" & "G" oszlopokat összefésüli az Excel2 "A" & "I" oszlopokkal "Ez amit már megoldottál!"
Amit még kéne hogy:
Az Excel1 "A" & "J" oszlopokat fésülje össze az Excel2 "A" & "J" oszlopokkal "Az elmélet ugyan az mint az előzőnél"
Továbbá van egy Excel3!
Amit itt kéne figyelnie :
Az Excel1 "A" & "K" oszlopait kéne összefésülnie az Excel3 "A" & "I" oszlopaival "Az elmélet ugyan az mint az előzőnél"Ami jó lenne,ha nem kéne megnyitni kézzel mind a három Excel táblázatot vagyis az Excel1 táblázatba levő makró futtatásakor azaz a futtatás idejére nyissa meg magától az Excel2 & Excel3 táblázatokat majd zárja is be őket.Az esetleg az mennyire számítana,hogy a makró indításakor megnyitná az Excel2 és lefuttatná az ellenőrzést és bezárná majd megnyitná az Excel3-at és lefuttatná itt is az ellenőrzést majd bezárná vagyis lehetőleg ne egyszerre legyen nyitva 3-darab Excel mert az lehet lassítaná.
Előre is köszönöm!
-
Delila_1
veterán
válasz
prodrakan
#2906
üzenetére
Beírtam a makróba, hogy amíg dolgozik, a státuszsorban megjelenik a "Nyugi, dolgozom" szöveg. Kevés adatnál nem látszik, olyan gyorsan eltűnik.
Pontosítanod kellene, melyik oszlopot akarod még figyeltetni, mit figyeljen a makró, és mit tegyen.
Sub Kikeres()
Dim UresSor As Long, WSInnen As Worksheet, WSIde As Worksheet
Dim TalalSor, usor As Long, WF As WorksheetFunction
Set WSInnen = Workbooks("Excel2.xlsx").Sheets("Munka1")
Set WSIde = Workbooks("Excel1.xlsm").Sheets("Munka1")
Set WF = Application.WorksheetFunction
WSIde.Activate
Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False
usor = Range("G" & Rows.Count).End(xlUp).Row
Do
UresSor = Range("G" & usor).End(xlUp).Row - 1
If UresSor < 3 Then
Application.StatusBar = False
Application.ScreenUpdating = True
Exit Sub
End If
If Cells(UresSor, "A") <> "" Then
On Error Resume Next
TalalSor = WF.Match(Cells(UresSor, "A"), WSInnen.Columns(1), 0)
Cells(UresSor, "G") = WSInnen.Cells(TalalSor, "I")
On Error GoTo 0
Else: usor = UresSor - 1
End If
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "G") = ""
End Sub -
prodrakan
csendes újonc
válasz
Delila_1
#2905
üzenetére
Na ez egész jónak tűnik!
Jó lenne,ha a másik Excel nem kéne külön megnyitnom,hanem a makró automatikusan a futtatás idejére megnyitná majd bezárná.
A másik kérdésem az lenne,hogy ugyanebbe a makróba macerás lenne belerakni plusz egy oszlop figyelést vagy inkább arra külön még egyszer ugyanezt csak átírom az "I" oszlop figyelést másra?
Msbox ablak felugorhatna arra az időre amíg ez lefut mondjuk egy olyan kiírással,hogy "Dolgozom" vagy "Adatokat gyűjtök"?Kíváncsi leszek,hogy több ezer sornál hogy fog lefutni,de remélem gyors lesz.
Köszönöm az eddigit is!
Üdv,
Laci -
-
prodrakan
csendes újonc
válasz
Delila_1
#2903
üzenetére
Excel1 A4=adat és G4=adat akkor ugrik a következő sorba és ott
A5=adat és G5=semmi akkor keresse az
Excel2-ben az Excel1 A5-öt méghozzá Excel2 A1:A50000-ig és ha mondjuk megtalálja az
Excel2 A3500-ban akkor az Excel2 I3500-cellában található adatott másolja át a
Excel1 G5-be de,ha nem talál semmit akkor folytassa az
Excel1 A6=adat és G6=adat akkor
Excel1 A7=semmi akkor itt vége a futtatásnakAz Excel1 és Excel2 csak a könnyebb magyarázat miatt van.
Remélem,így jobban értelmezhető. -
prodrakan
csendes újonc
válasz
Delila_1
#2901
üzenetére
[kép]
Szia!Köszönöm a segítséget,de szerintem nem jól írtam le valamit mert ez így nem az amit szerettem volna.
Csatoltam egy képet.
Van egy "Excel1" ami tartalmaz A-oszlopot és egy G-oszlopot és az A-oszlop adatát kell ellenőriznie egy másik "Excel2" A-oszlopába és ha megtalálta akkor a vele egy vonalba az I-oszlopba található adatot másolja át az "Excel1" A és G oszlop metszéspontjába.
A függvényt csak addig futtassa,amíg az Excel1 A-oszlopába van adat. -
Delila_1
veterán
válasz
prodrakan
#2900
üzenetére
Próbáld ezzel:
Sub IndexFuggveny()
Dim UresSor As Long
UresSor = Range("K1").End(xlDown).Row + 1
Do
If Cells(UresSor, "A") = "" Then UresSor = UresSor + 1
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "K") = ""
Range("C" & UresSor & ":C5000") = "=INDEX('\\Hubudr99102dat\mf\MF3\" _
& "FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$I$" & UresSor & ":$I$5000;HOL.VAN(A" & UresSor & "," _
& "'\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$A$" & UresSor & ":$A$5000,0))"
End SubA Range("K1").End(xlDown).Row a K1 cellán nyomott Ctrl+le művelet VBA-s megfelelője. Ez az első, üres cella fölötti sor értékét adja meg. 1-et hozzáadva megkapjuk az első üres cella sorát a K oszlopban.
Ha ez a sor az A oszlopban üres, addig növeljük a sorszámot, míg igaz nem lesz, hogy a K üres, az A nem.
Ide, ill. innen az ötezredik sorba írjuk be (nálam a C oszlopba, te majd átírod) a hosszú képletedet, egy lépésben.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
(táblák, lekérdezések, rendezés, megjelenítés)
Új hozzászólás Aktív témák
Hirdetés
- Bomba Ár! Dell Latitude 3190 - Intel N4120 I 4GB I 128GB SSD I 11,6" HD I Cam I W11 I Garancia!
- Bomba Ár! Dell Latitude 3190 - Intel N4120 I 4GB I 64GB SSD I 11,6" HD I Cam I W11 I Garancia!
- Bomba ár! Dell Latitude E6520 - i7-2760QM I 8GB I 256SSD I Nvidia I HDMI I 15,6" HD+ I W10 I Gari!
- Bomba ár! Dell Latitude E7240 - i7-4GEN I 16GB I 256SSD I 12,5" HD I HDMI I Cam I W10 I Garancia!
- Bomba ár! Toshiba Satellite Pro R50-C - i3-6G I 4GB I 128GB SSD I 15,6" I HDMI I Cam I W10 I Gari!
- HATALMAS AKCIÓK / MICROSOFT WINDOWS 10,11 / OFFICE 16,19,21,24 / VÍRUS,VPN VÉDELEM / SZÁMLA / 0-24
- Bomba ár! HP ProBook 430 G3 - i5-6GEN I 8GB I 256SSD I HDMI I 13,3" HD I Cam I W10 I Garancia!
- Honor Magic7 Lite 256GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! iPhone 14/iPhone 14 Plus/iPhone 14 Pro/iPhone 14 Pro Max
- ÁRGARANCIA!Épített KomPhone Ryzen 5 5500 16/32/64GB RAM RTX 4060 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: CAMERA-PRO Hungary Kft
Város: Budapest