Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Gyorskeresés
Legfrissebb anyagok
Szakmai témák
PROHARDVER! témák
Mobilarena témák
Általános témák
GAMEPOD.hu témák
Hirdetés
Hozzászólások

Delila_1
(őstag)
Sziasztok
Van egy ilyen macro-m:
Private Sub CommandButton1_Click()
sh = Range("J1")
n = 1 + Range("A3")
Sheets(sh).Cells(n, 1) = Range("a3")
Sheets(sh).Cells(n, 2) = Range("b3")
Sheets(sh).Cells(n, 3) = Range("c3")
Sheets(sh).Cells(n, 4) = Range("d3")
Sheets(sh).Cells(n, 5) = Range("e3")
Sheets(sh).Cells(n, 6) = Range("f3")
Sheets(sh).Cells(n, 7) = Range("g3")
Sheets(sh).Cells(n, 8) = Range("h3")
Sheets(sh).Cells(n, 9) = Range("i3")
Sheets(sh).Cells(n, 10) = Now()
Range("A3") = 1 + Range("a3")
End Sub
A J1-ből veszi a Sheet nevét. Hogyan lehetne azt megoldani, hogy hozza is létre a Sheetet, ha a nincs még ilyen névvel. Ha van ilyen névvel, akkor meg találja meg és írja be az adatokat.
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy
Igazából napi szinten akarom szétszedni az adatokat, ezért a Sheet-ek neve 2010.08.26 formátumban kellenének. Így amilyen nap van, annak megfelelő Sheetre másoljon.
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy

Delila_1
(őstag)
Fire most nem ér rá, azért szállok be a megoldásba.
Vegyük, hogy az első lapon vannak a szűrt adataid, a Munka2 lapon lesz a "népszámlálás", ott is a B1 cellában.
Sub MennyiAzAnnyi()
Sheets(2).Range("A:A") = ""
Sheets(1).Range("A:A").Copy Destination:=Sheets(2).Range("A1")
Sheets(2).Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="ter", RefersTo:="=Munka2!" & Selection.Address
Range("B1").FormulaArray = "=SUM(1/COUNTIF(ter,ter))"
End Sub
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

Delila_1
(őstag)
A dátum végére is tegyél pontot a lapneveknél, mert a VB saját változója (Date) is így írja.
Sub Lapok()
Dim sheetnev As String
sheetnev = Date
On Error Resume Next
Sheets(sheetnev).Select
If Err.Number <> 0 Then Worksheets.Add.Name = sheetnev
On Error GoTo 0
End Sub
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

Delila_1
(őstag)
Nem figyeltem, hogy a makró a J1-ből veszi a lapnevet. Akkor a sheetnev=Date helyett sheetnev=cells(1,10) kerül, és a lapnevek végére sem kell pont.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Ez majdnem tökéletes is... Annyi a bajom vele, hogy így az adat sheeten marad a "kurzor"
Tudom... egy egyszerű Select-tel visszalép, de ezt a lépést nem lehetne megspórolni?
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy
Nem jó...
Elnevezi az új lapot ponttal a végén, de írni már nem tud bele...
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy

Delila_1
(őstag)
Átírtad a sheetsnev=Date sort? #8006
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Átírtam, de valamiért nem tetszik neki, ha dátumként kezelem a Sheet nevét, ezért úgy oldaottam meg, hogy a forrás szöveg legyen:
=CONCATENATE(YEAR(TODAY());".";MONTH(TODAY());".";DAY(TODAY()))
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy

Delila_1
(őstag)
A lapnév mindig string típusú. A #8005-ben ezért dimenzionáltam.
Dim sheetnev As String
Kipróbáltam, ha a J1-ben van a MA() függvény, bár ott az alapbeállítási formában (2010.08.26) jelenik meg, a létrehozott új lap neve ponttal a végén születik. Újabb futtatásnál a "pontos" lap lesz aktív.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Akkor fogalmam se nem van, hogy mi történt, de nem is érdekel, mert működik.
Már csak azt kellene megcsinálni, hogy a amikor nem talál ilyen lapot, akkor az új lap létrehozásával egyidejűleg egy másik műveletet is csináljon meg. Range("A3") = 1
Azt a Then után hova írjam?
[ Szerkesztve ]
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy

Delila_1
(őstag)
Ha a Date függvényt használod a makróban, nincs szükség a J1-re - legalábbis a lapnévhez nem kell.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

Delila_1
(őstag)
Sub Lapok()
Dim sheetnev As String
sheetnev = Cells(1, 10)
On Error Resume Next
Sheets(sheetnev).Select
If Err.Number <> 0 Then
Worksheets.Add.Name = sheetnev
Sheets(sheetnev).Cells(3, 1) = 1
End If
On Error GoTo 0
End Sub
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Köszönöm a segítséget...
Lassan meg is tanulok VB-ül... 
Uccsó kérdés:
Miért nem lehet Tabulátorral lépegetni a vezérlők közt?
[ Szerkesztve ]
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy

Delila_1
(őstag)
Szívesen. 
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

basaharc502
(lelkes újonc)
Igen, köszönöm, ez íg yteljesen jó lesz
Thx mégegyszer 

Delila_1
(őstag)
Szívesen.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

DopeBob
(őstag)
Még egyszer, hátha valaki tud segíteni 
MZ/X
Hali!
Delila_1 megoldása miért nem jó?
Vagy átsiklottál rajta? ![;]](/dl/s/v1.gif)
Fire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

DopeBob
(őstag)
megyek elbujdosok 
MZ/X

DopeBob
(őstag)
Köszönöm, rögtön kipróbálom 
MZ/X

DopeBob
(őstag)
Működik, nagyon szépen köszönöm mindkettőtöknek a segítséget! 
MZ/X

iwu
(PH! addikt)
helló,
lenne egy kedves kis feladatom. önerőből képtelen vagyok megoldani, de vannak itt guruk,hátha valaki tud segíteni
Előre is köszi!
Tehát, van egy nagy excel file, aminek az egyik sheetjének az a1 cellája a =MA() függvénnyel kiszedi a mai napot, és ez alapján a dátum alapján teleírja a munkalapot mindenféle adattal.
az lenne a feladat, hogy ezt a munkalapot minden reggel 8kor el kéne küldeni a megadott mél címre.
igazából a küldést meg tudom simán oldani powershellel, ha az excelnek nem megy, de ahhoz is le kéne kreálni egy új excel filet, amit küldenék.
ötletek, megoldási javaslatok, ne adj isten megoldás?
üdw,iwu
ajándék ló nem látja a fától a szódás a lovát...

DopeBob
(őstag)
Csak egy kérdés, amit nem értek. Miért kell egy új excel fájt csinálni? 
MZ/X

iwu
(PH! addikt)
nem kell. de ha lenne új fájl, azt már tudnám küldeni ps scriptel. meg az eredeti file brutál nagy, azt nem lenne jó küldözgetni.
ha tudná az excel, hogy zsigerből ellő egy sheetet, az lenne a legparádébb
üdw,iwu
ajándék ló nem látja a fától a szódás a lovát...

DopeBob
(őstag)
akkor ha jól értem egy excel táblából egy munkalapot külön lementeni, és elküldeni e-mailban. Hmm
VBScript?
[ Szerkesztve ]
MZ/X

Delila_1
(őstag)
Nézd meg a testreszabásnál

ezeket az ikonokat, és alkalmazd azt, amelyik megfelel. Egyikkel szöveges üzenetet küldhetsz, a másikkal az aktuális lap képét küldheted, a harmadikkal a teljes fájlt csatolohatod a levélhez. 2003-as verzió.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

DopeBob
(őstag)
Ameddig nem lesz jobb, itt egy ilyen tákolós megoldás 
Egy VB Script ami elindítja az excelt megnyitja a fájlt aztán bezárja:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Temp\Munkafüzet2.xlsm", 0, True)
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Meg egy makró ami szétbobja a munkafüzetet munkalapokra
'Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
Dim strSavePath As String
Application.ScreenUpdating = False 'Don't show any screen movement
strSavePath = "C:\Temp\" 'Change this to suit your needs
Set wbSource = ActiveWorkbook
For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name
wbDest.Close 'Remove this if you don't want each book closed after saving.
Next
Application.ScreenUpdating = True
Ha a Workbook.Open-hez teszed, lefut minden indulások.
Elvileg a VBSriptbe is be lehetne írni, hogy futtasson makrót ( xlApp.Run "MyMacro" ) de nálam nem akar menni valamiért 
Az e-mail küldés meg megy akkor. 
MZ/X

iwu
(PH! addikt)
ez megvan, csak ezt kéne automatizálni
DopeBob vbscriptet megsasolom
thx all!
[ Szerkesztve ]
ajándék ló nem látja a fától a szódás a lovát...

Delila_1
(őstag)
Rögzíted egy makróban onnan kezdve, hogy a kérdéses lapot átmásolod egy új fájlba, csatolva elküldöd a megfelelő címekre. Az ikonok közé kiteszel egy "Egyedi gomb"-ot a Makrók kategóriából, és hozzárendeled a rögzített makródat.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

iwu
(PH! addikt)
nah, ez is király ötlet

visszaérek, megnézem. thx!
ajándék ló nem látja a fától a szódás a lovát...

Tier555
(újonc)
Üdvözlet,
Azt szeretném kérdezni, hogy szerintetek ha adott 2 db excel file akkor meg lehet valósítani azt, hogy az egyik oszlopban ha értéket találok azt másoljam át a másik file egyik oszlopába de csak akkor ha a az adott sort azonosító másik oszlopban taláható ID ( sajnos nem numerikus, hanem egy sztring ) megegyezik a két esetben.
Tehát a 6. oszlopban fut a keresés és ha adatot talál azt kell másolja a másik file vagy munkalap 6. oszlopába, DE nem ugyanabba a sorba.
Hanem ahonnét másolok ott az első oszlopban kódok találhatók és ez a sztirngsor azonosítja majd a másolandó sztringet, mert a másik munkalapon én majd abba a sorba szeretném másolni amelyik sorban megtalálható ez a 'kulcs' sztring sor.
KERES fügvényekkel ez annyira nem sikerül.
A kérdésem, hogy ez már csak makró vagy Access vagy van megoldás egyszerűbben is?
Köszi a válaszokat előre is.

Delila_1
(őstag)
Az FKERES függvénnyel oldhatod meg.
A leírásból nekem nem nagyon derül ki, melyik adatod hol van. Készítettem 2 füzetet, Egyik.xls, és Másik.xls néven.
Az Egyik A oszlopába írtam stringeket, amik az ID-ket képviselik, a 6. (F) oszlopba pedig számokat. A Másik füzet A oszlopába véletlenszerű elrendezéssel betettem az előző ID-ket.
A Másik füzet F2 képlete (címsort feltételezve)
=FKERES(A2;'[Egyik.xls]Munka1'!$A:$F;6;HAMIS)
Nézd meg a súgóban az Fkeres függvényt, és a fenti képletet, ha más az oszlopaid elrendezése, a kettő együtt biztosan segít.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/

Tier555
(újonc)
Üdv,
erről van szó:
Tehát adott 2 db xls file: a.xls és b.xls
Mindkettő struktúrája azonos.
1. oszlop azonosító szting
2. oszlop márkanév
3. oszlop adat
4. oszlop adat
5. oszlop adat
6. oszlop keresendő sztring azonban csak a.xls-ben van adattartalma.
A feladat, hogy az a.xls 6. oszlopának tartalmát másoljam b.xls 6. oszlopába de nem ugyanazokba a sorszámú sorokba, ahol a.xls-ben is voltak, hanem az 1. oszlop által azonosított sorba.
Vagyis fut a kereső az a.xls 6. oszlopában. A 9. sorban talál egy sztringet, akkor és csakis akkor meg kell néznie az a.xls első oszlopában a 9. sorhoz tartozó azonosító sztringet, majd átmásolni a 6. oszlop adattartalmát a b.xls 6. oszlopának azon sorában ahol a ugyanaz az első oszlopbeli sztring azonosító található meg.
Ha ezt tudja az FKERES akkor a paramétereket adom meg rosszul. Mi a helyes megadás?
Köszönöm szépen a segítséget!!
Hali!
Csak egy kérdés: Az 1. oszlopban lévő azonosítók egyediek vagy több azonos azonosító is szerepel az oszlopban? Esetleg az a.xls 1. oszlopában egyediek, míg a b.xls 1.oszlopában több is lehet belőle?
(ha így van, akkor ez adatbázis kezelésre emlékeztet, ahol pl van két tábla, az egyikben vannak a termékek egyedi azonosítóval, míg a másik táblában meg pl az eladások, ahova a termékek az egyedi azonosítójukkal kerülnek be, de többször is, hisz többször adták el őket.)
Te is valami hasonlót(az elv a lényeg, nem a konkrét példa) szeretnél kivitelezni, csak két excel munkafüzet segítségével?
(Ez a kérdés nem annyira fontos, az első kérdés a lényeg)
Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

Tier555
(újonc)
Szia,
Mind2 esetben egyediek az azonosítók azaz csak 1x szerepelnek a táblázatban.
Második kérdésre is igen a válasz. Az már persze mindegy, hogy bemásolom egy munkalapra vagy 2 munkalap vagy 2 külön file.

Delila_1
(őstag)
Kitehetnéd a füzeteidet néhány adattal valami elérhető helyre, akkor kiderülne, miért nem talál nálad az Fkeres.
Lehet, hogy csak az egyik lapon string típusú az ID. Azon lehet segíteni.
Nézd meg a másik fórumon is a választ, ahol feltetted ugyanezt a kérdést, ott írtam erről.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. http://www.elektroabc.hu/
Hali!
Pont ezért kérdeztem, azt amit, mert ami megoldást adtál(FKeres), az végül is alapjaiban jó...
Fire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

zsotesz81
(fanatikus tag)
Hi!
Van egy formom amin van egy listbox és egy gomb.Ha megnyomom ezt a gombot feljön egy újabb form amin van egy szövegdoboz. Azt hogy kell megcsinálni ha ide beírok egy nevet akkor azt adja hozzá a listboxhoz?
Hali!
Példa: adott 2 form
UserForm1(ezen van ListBox1 és CommandButton1)
UserForm2(ezen van TextBox1 és CommandButton1)
Így jeleníted meg a UserForm2-t, UserForm1-ről
Private Sub CommandButton1_Click()
UserForm2.Show vbModal
End Sub
Így adod hozzá a TextBox1 szövegét, a UserForm1-en található ListBox1-hez, majd bezárom a UserForm2-t
Private Sub CommandButton1_Click()
UserForm1.ListBox1.AddItem (TextBox1.Text)
Unload Me
End Sub
Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

zsotesz81
(fanatikus tag)
zsír, köszönöm

zsotesz81
(fanatikus tag)
azt meg lehet valahogy oldani, hogy a listbox megtartsa az adatokat?
Hali!
Már úgy érted, hogy minden induláskor előre meghatározott elemekkel induljon, vagy azt is vegye figyelembe, amit pl a Textbox-ból hozzáadtál?
Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

zsotesz81
(fanatikus tag)
Csak azokat vegye figyelembe amiket textboxból hozzáadok.
Hali!
Az a lényeg, hogy a listboxban bekövetkezett változások mentésre kerüljenek(nem csak a hozzáadás, hisz szükség lehet a listboxból kitörölni is eleme(ke)t).
Több módszer is lehetséges pl külső munkafüzetben, külsö fájlban(pl egy TXT fájlban) vagy egy másik munkalapon(talán ez a legegyszerűbb és célszerűbb is)
Melyik legyen?
Fire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

zsotesz81
(fanatikus tag)
Legyen a munkalapos. Meg van még egy kérdésem, azt szeretném hogy amikor beírom a nevet a szövegdobozba akkor azt az enter leütésével elfogadja, tehát ne kelljen külön az ok gombra kattintani. Ezt be is állítottam (Private Sub cmdok_Enter()), viszont amikor leütöm az entert akkor kijelöli a cancel gombot, majd ha innen rámegyek a bal kurzor gombbal az ok-ra akkor fogadja el. Ez vajon miért van? Ilyet pedig már csináltam korábban és akkor működött.
Hali!
Az ENTER-es problémára
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
UserForm1.ListBox1.AddItem (TextBox1.Text)
Unload Me
End If
End Sub
Fire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)

zsotesz81
(fanatikus tag)
így már jó, thx
Hali!
Hozz létre a munkafüzetben egy listbox1 nevű munkalapot. A kód ide fogja kimásolni minden módosításnál a ListBox1 elemeit.
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 And TextBox1.Text <> "" Then
UserForm1.ListBox1.AddItem (TextBox1.Text)
Sheets("listbox1").Select
Sheets("listbox1").UsedRange.Delete
For i = 0 To UserForm1.ListBox1.ListCount - 1
Sheets("listbox1").Cells(i + 1, 1) = UserForm1.ListBox1.List(i)
Next i
Unload Me
End If
End Sub
Fire.
UI: Házi feladat (egy kicsit meditálj rajta), hogy ez alapján hogy lehet visszaolvasni az adatokat a munkafüzet megnyitásakor. Ha nem megy, akkor persze írj nyugodtan, de egy kicsit azért törd a buksid... ![;]](/dl/s/v1.gif)
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)












