-
Fototrend
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
-
thee
csendes tag
Megint "elakadtam"..
Ezt az excel-es parancsot szeretném VB-es környezet alatt megírni:=SOKSZOR("kiskutya";5)
Eddig nekem ezt sikerült összehoznom:
Dim Counter, Piece As Integer
Dim Text, Text1 As String
Piece = 5
Counter = 0
Text = "kiskutya"
Do While (Counter < Piece)
Text1 = Text1 & Text
Counter = Counter + 1
Loop
Worksheets("Munka1").Cells(11, 2) = Text1Tudtok ajánlani ennél egy egyszerűbb megoldást?
-
félisten
-
thee
csendes tag
válasz Fire/SOUL/CD #13552 üzenetére
Köszönöm!
-
ThaBoss
senior tag
Sziasztok!
Visszatértem egy kis segítséget kérni! Volt nemrég ez a gondom: [link], amit Delila_1 segítségével sikerült megoldani. Azóta is tökéletesen üzemel a makró:
Sub Valami()
Dim sor%, sor1%, WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)sor% = 2: sor1% = 2
WS2.Cells(sor1%, "A") = WS1.Cells(sor%, "A")
WS2.Cells(sor1%, "B") = WS1.Cells(sor%, "A")Do While WS1.Cells(sor%, "A") <> ""
If WS2.Cells(sor1%, "A") < WS1.Cells(sor%, "B") Then
WS2.Cells(sor1% + 1, "A") = WS2.Cells(sor1%, "A") + 1
WS2.Cells(sor1% + 1, "B") = WS2.Cells(sor1%, "A") + 1
sor1% = sor1% + 1
Else
sor1% = sor1% + 1: sor% = sor% + 1
WS2.Cells(sor1%, "A") = WS1.Cells(sor%, "A")
WS2.Cells(sor1%, "B") = WS1.Cells(sor%, "A")
End If
Loop
End SubSzeretnék beiktatni egy C és D oszlopot is. A és B változatlanul maradna és a makró feladata is. Viszont minden sor C és D oszlopában szerepelne valami információ szöveg vagy képlet (sima számítás pl: =2*1000+3*500+100). Ezeket pedig szeretném kilistázni minden egyes sorba a második fülre az eredmény (azaz A és B oszlop cellái) után úgy, hogy csak addig írja ki ezeket, amíg az első lap A és B tartománya tart.
Kissé bonyolult így de adok képet is hozzá! Tehát így néz ki a táblám első füle:és azt szeretném, ha a fenti makró valami ilyet csinálna belőle:
Előre is köszi!
-
Delila_1
Topikgazda
válasz ThaBoss #13556 üzenetére
Óhajod parancs.
Sub Valami_1()
Dim sor%, sor1%, WS1 As Worksheet, WS2 As Worksheet
Dim info, képlet, usor, kezd
Set WS1 = Sheets(1): Set WS2 = Sheets(2)
sor% = 2: sor1% = 2
usor = WS1.Cells(sor%, "A").SpecialCells(xlLastCell).Row
info = WS1.Cells(sor%, "C"): képlet = WS1.Cells(sor%, "D")
kezd = WS1.Cells(sor%, "A")
For sor% = 2 To usor
If WS1.Cells(sor% + 1, "D") <> képlet Then
WS2.Cells(sor1%, "A") = kezd
WS2.Cells(sor1%, "B") = WS1.Cells(sor%, "B")
WS2.Cells(sor1%, "C") = WS1.Cells(sor%, "C")
WS2.Cells(sor1%, "D") = WS1.Cells(sor%, "D")
sor1% = sor1% + 1
kezd = WS1.Cells(sor% + 1, "A")
képlet = WS1.Cells(sor% + 1, "D")
End If
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
m.zmrzlina
senior tag
Adott egy táblázat:
"A" oszlopban azonosító számok, B oszloptól kezdődően egy sorban az azonosító számokhoz tartozó adatok (kb 50) Ebből a szerkezetből van mondjuk 200 sor.Másik munkalapon egy form amit fel kell tölteni egy adott azonosítóhoz tartozó adatokkal természetesen nem sorban.
Hirtelen nem nagyon látok más módszert mint egyenként másolni a cellákat
egyik!A1--->másik!B5
egyik!B1--->másik!B26
egyik!C1--->másik!C5
.
.
.
egyik!AJ1--->másik!P27Van-e valami elegánsabb módszer ennél? Mire érdemes guglizni?
-
Delila_1
Topikgazda
válasz ThaBoss #13558 üzenetére
Teljesen más a két feladat, még ha ugyanazokkal az adatokkal dolgozol is. Mit akarsz összegyúrni?
Nálam prímán működött a makró, anélkül nem tettem volna ki. Mondanám, hogy küldd el a füzetet, de mostanság nem nagyon van időm.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz m.zmrzlina #13559 üzenetére
Nem látom a rendszert, pedig a programok erre épülnek.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
m.zmrzlina
senior tag
válasz Delila_1 #13561 üzenetére
Itt egy végletekig leegyszerűsített illusztráció:
A felső öt sor az adatbázis. A valóságban természetesen sokkal nagyobb sor és oszlop irányban is. A bekeretezett rész a form amit ki kell tölteni. A valóságban külön munkalapon vannak.
A harmadik munkalapon van egy lista ami részhalmaza a az A oszlopban lévő számoknak(azonosítók). MATCH()-csel megkeresem a lista első elemét az adatbázisban majd a hozzá tartozó adatokat beírom a formba majd mentem a formot egy új munkafüzetbe.
Ezután form törlése, a lista második elemének keresése, form kitöltés, mentés stb... amíg van a listában elem.A keresés és a mentés nem gond csak a form kitöltésére keresek egy elegánsabb megoldést mit hogy a:
Worksheets("lista").Range("A" & sor).Copy Worksheets("űrlap").Range("A2")
sort leírjam 50-szer néha többször (természetesen megfelelő cellahivatkozásokkal) a makróba. (a hivatkozásokat ne nézd nem illenek az képhez)
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz m.zmrzlina #13563 üzenetére
Az adat_3:adat_7, és az adat_10:adat_15-öt (esetleg az adat_18:adat_19-et is) ciklusban íratnám be. Akkor csak az adat_1 és adat_2 van szólóban.
sor = 1
For oszlop = 4 To 8
Cells(oszlop + 13, 3) = Cells(sor, oszlop)
NextFejreálltam a próbánál. Indítottam, és nem csinált semmit. Aztán rájöttem, hogy a belinkelt képedet néztem, az nem változott.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
m.zmrzlina
senior tag
válasz Delila_1 #13566 üzenetére
Amint írtam az adatbázis és a form is bonyolultabb a kép csak illusztráció.
Arra gondoltam, hogy nem lehetne-e bevezetni változót minden adatra (ami akár 50-nél több különböző változót jelentene) Ezt viszonylag könnyen fel lehet tölteni ciklussal, aztán kiirogatni megfelelő helyre a formra.
Nincsen ötletem.
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz ThaBoss #13565 üzenetére
Itt az inverze.
Sub Valami_3()
Dim sor%, sor1%, ucso%, WS1 As Worksheet, WS2 As Worksheet
Dim kezd, vég
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
sor1% = 1
ucso% = WS1.Cells(Rows.Count, "A").End(xlUp).Row
For sor% = 2 To ucso%
kezd = WS1.Cells(sor%, "A")
vég = WS1.Cells(sor%, "B")
Do
sor1% = sor1% + 1
If WS1.Cells(sor%, "B") > WS1.Cells(sor%, "A") Then
WS2.Cells(sor1%, "A") = kezd
WS2.Cells(sor1%, "B") = kezd
WS2.Cells(sor1%, "C") = WS1.Cells(sor%, "C")
WS2.Cells(sor1%, "D") = WS1.Cells(sor%, "D")
kezd = kezd + 1
End If
Loop While vég >= kezd
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
psg5
veterán
Excel fájlban vonalkódok,melyek egy függvénnyel egy helyre mutatnak,gépre vonalkód olvasó kötve, amikor a vonalkódólvasó talál egy olyan vonalkódot, mely szerepel az excel vonalkódjai közt, akkor az excel kijelzi, hogy itt van tessék. A kérdésem, hogy hangjelzést lehet-e rendelni az excelben ahhoz, hogy a találatnál zenéljen, kürtöljön vagy bármilyen hangot adjon?
F.K.T.
-
Delila_1
Topikgazda
válasz ThaBoss #13575 üzenetére
Nem sok munkád lehet. Ebből a megadott 3 sorból, mire egyet pislogtam, már kész lett a 138 új sor.
Ezt viccnek szántam, nehogy komolyra vedd. Igazán örülök, hogy segíthettem.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
BlackGu
csendes tag
Sziasztok!
Lehet kezdő a kérdés, de fontos lenne a megoldás.
Annyit szeretnék, hogy egy legördülő menüben elhelyezett nevekhez, pl (alma,körte,barack) egy másik cellában csak az adott névhez megfelelő legördülő lista elemk jelenjenek meg. Ha az almát választom akkor zöld, piros. Ha a körtét akkor sárga , vilmos. Persze ezek is legördülő listák lennének. Megoldható ez programozás nélkül? Esetleg tippek, hol találok hasonló példát, de ha kapok megoldást annak nagyon örülnék. -
Delila_1
Topikgazda
válasz ThaBoss #13577 üzenetére
Ha milliós sorszámod van, módosítani kell a makrón. A % jelet vedd le a változók végéről, és a Dim kezdetű sorokban így add meg: Dim sor As Double.
A % jellel a végén azonos a Dim sor As Integer-rel, de ez csak -32.768 és 32.767 közötti értékekre jó, ezen a tartományon kívül hibára futna.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
psg5
veterán
Erre ötlet? Excelbe (2003) hang hozzárendelés megoldás?:
KérdésF.K.T.
-
Delila_1
Topikgazda
Ez a makró megcsinálja. Előbb új lapokra másolja az egyes sorokat, mindegyiket olyan nevű lapra, amilyen adatot tartalmaz az adott sor első (A) cellája.
Ezután az egyes lapokat áthelyezi 1-1 új fájlba, aminek a neve a lapnév + "_adott adat".Az utvonal = "E:\Eadat\" sorban írd át az útvonalat a sajátodra, a végén is legyen \ jel, mint itt.
A nev$ = utvonal & Sheets(1).Name & "_adott adat.xls" sor végén az .xls helyett írj .xlsx-et, ha 2003-asnál magasabb verziót alkalmazol.Címsort feltételezek, ezért az első ciklust (sorok másolása másik lapokra) a 2. sortól kezdtem a For sor% = 2 To usor% sorban. Címsor nélkül legyen ez a sor For sor% = 1 To usor%.
Sub Ujak()
Dim sor%, usor%, usor_1%, nev$, WS1 As Worksheet
Dim utvonal$, lap%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
utvonal = "E:\Eadat\" 'Itt írd be a saját útvonaladat ehelyett
usor% = Cells(Rows.Count, "A").End(xlUp).Row
Set WS1 = Sheets("Kezdőlap")
For sor% = 2 To usor%
nev$ = WS1.Cells(sor%, "A")
On Error GoTo Uj_lap
usor_1% = Sheets(nev$).Cells(Rows.Count, "A").End(xlUp).Row + 1
WS1.Rows(sor%).Copy Sheets(nev$).Cells(usor_1%, "A")
Next
For lap% = 1 To Sheets.Count - 1
nev$ = utvonal & Sheets(1).Name & "_adott adat.xls"
Sheets(1).Move
ActiveWorkbook.SaveAs Filename:=nev$, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Kész"
Exit Sub
Uj_lap:
If Err = 9 Then
Worksheets.Add.Name = nev$
Resume 0
Else
Error Err
End If
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
ThaBoss
senior tag
válasz Delila_1 #13580 üzenetére
Egyelőre még a régi makrót használom (integer-es), mert most valószínűleg nem lesz dolgom óriási adathalmazokkal, így nincs szükség a módosítottra.
Viszont belefutottam egy apróságba:
Ha A és B oszlop eleme ugyanaz, akkor meghal a makró. Ezen lehet változtatni valahogyan, hogy ilyenkor is rendben legyen?
Töltöm fel a táblát: [link] -
Delila_1
Topikgazda
válasz ThaBoss #13585 üzenetére
Az If WS1.Cells(sor%, "B") > WS1.Cells(sor%, "A") Then sor legyen
If WS1.Cells(sor%, "B") >= WS1.Cells(sor%, "A") Then.
Szerk.: írd át a % végű változókat, amíg nem felejted el. Később már esetleg nem emlékszel rá, miért áll le hibával a futás.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
ThaBoss
senior tag
válasz Delila_1 #13586 üzenetére
Köszönöm szépen ismét!
Lemásoltam a táblát, a másolatban már javítva van %-os változó, gondoltam azt majd akkor veszem elő, ha szükséges. Abban is átírtam.
Amúgy nem tudsz valami jó szakirodalmat vagy blogot a makrózásról, amiből tanulgathatnék? Természetesen 0-ról indulok...
[ Szerkesztve ]
-
-
bugizozi
őstag
válasz ThaBoss #13587 üzenetére
A legjobb oldal
Viccen kívül én némi más nyelvű programozási tapasztalattal innen szedtem az összes tudásom + amit ebben a fórumban olvastam / kérdeztem!VCP7-DCV, CCNA ||| Ami működik, ahhoz nem szabad hozzányúlni!
-
ThaBoss
senior tag
válasz Delila_1 #13590 üzenetére
Találtam már egy képletgyűjteményt, az egész jól elmagyarázza, hogy mikor mit érdemes használni és mindenhez van egy példa is.
Csak most kicsit továbbmennék a makrók felé.
Ha esetleg tudsz olyat, ami hasonló módon példákkal operál, azt szívesen veszem.bugizozi: ha minden kötél szakad, ez a legjobb mindig!
[ Szerkesztve ]
-
-
Delila_1
Topikgazda
Régebbi hozzászólásokból tallóztam össze.
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Sub PlayWAV()
utvonal = "E:\Utvonal\" 'Itt módosíts
WAVFile = utvonal & "\" & "Fáljnév.wav" 'meg itt is
Call PlaySound(WAVFile, 0&, SND_SYNC Or SND_FILENAME)
End SubA most PlayWAV rutin sorait eseményvezéreltként vidd be.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- World of Warcraft Shadowlands Collectors edition EU EN
- Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Steam, Windows, Origin kulcsok, előfizetések közvetlenül a kiadótól, a LEGJOBB ÁRON!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Eredeti Windows, telepítéssel! Digital Doctor Számítógép Szerviz