- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Bemutatkozott a Poco X7 és X7 Pro
- Garmin Venu X1 - vékony, virtuóz, váltságíjas
- iPhone topik
- Yettel topik
- Apple Watch Ultra - első nekifutás
- Huawei Watch Fit 3 - zöldalma
- Samsung Galaxy A53 5G - kevesebbet többért
- Gyorsabb és drágább - kezünkben a Samsung Galaxy S23
- Három Redmi 15 érkezett a lengyel piacra
Hirdetés
Talpon vagyunk, köszönjük a sok biztatást! Ha segíteni szeretnél, boldogan ajánljuk Előfizetéseinket!
-
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
-
Fferi50
Topikgazda
válasz
pirit28
#29304
üzenetére
Szia!
Ezt a makrót beteszed egy modul lapra (de akár az adott munkalap kódlapjára is teheted), majd elindítod. Persze tetszés szerint átnevezheted.
A makró végigmegy a C oszlopon az utolsó nem üres celláig és beírja a C oszlopban levő érték alapján a D oszlopba a kívánt értéket (ez utóbbit csak remélem, hogy eltaláltam).
Annyiszor futtatod, ahányszor akarod, mindig újraírja a D oszlop celláit az aktuális C oszlop szerint.Sub kitalalo()
Const oes = "hattorf,Győr,Ford,Pors,BMW,AUDI,hmmc,kms,Sassenburg,Figueruelas,Grossmehring,Sindelfingen,Bremen,Koeln,Voelklingen,Seat,emden,Genk,Daventry,VW,BENZ,Swarzedz,Hannover,(OE)"
Const whs = "WH,W/H"
Dim beir As String, cl As Range
For Each cl In Range("C11:C" & Cells(Rows.Count, "C").End(xlUp).Row).Cells
If cl.Value = "" Then
beir = ""
Else
If oes Like "*" & cl.Value & "*" Then
beir = "OE"
Else
If whs Like "*cl.value" & "*" Then
beir = "W/H"
Else
beir = "DFC"
End If
End If
End If
cl.Offset(0, 1).Value = beir
Next
End SubÜdv.
-
#29309
m.zmrzlina
senior tag
pirit28
#29304
m.zmrzlina
senior tag
válasz
pirit28
#29304
üzenetére
Ahhoz munkalaphoz rendeld amin az adataid vannak!
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
If Target.Value = "" Then
Target.Offset(0, 1).Value = ""
ElseIf Target.Value = "*hatroff*" Or Target.Value = "*Győr*" Or Target.Value = "*(OE)*" _
Or Target.Value = "*Ford*" Or Target.Value = "*Pors*" Or Target.Value = "*BMW*" _
Or Target.Value = "*AUDI*" Or Target.Value = "*hmmc*" Or Target.Value = "*kms*" _
Or Target.Value = "*Sassenburg*" Or Target.Value = "*Figueruelas*" Or Target.Value = "*Grossmehring*" _
Or Target.Value = "*Sindelfingen*" Or Target.Value = "*Bremen*" Or Target.Value = "*Koeln*" _
Or Target.Value = "*Voelklingen*" Or Target.Value = "*Seat*" Or Target.Value = "*emden*" _
Or Target.Value = "*Genk*" Or Target.Value = "*Daventry*" Or Target.Value = "*VW*" _
Or Target.Value = "*Benz*" Or Target.Value = "*Swarzedz*" Or Target.Value = "*Hannover*" Then
Target.Offset(0, 1).Value = "OE"
ElseIf Target.Value = "*WH*" Or Target.Value = "*W/H*" Then
Target.Offset(0, 1).Value = "W/H"
Else
Target.Offset(0, 1).Value = "DFC"
End If
End If
End Sub -
Fferi50
Topikgazda
válasz
pirit28
#29300
üzenetére
Szia!
Mivel jelen esetben egyetlen cella tartalmát vizsgálod, továbbá a countif csak azt mondja meg, hogy a cellában van olyan érték (lehet, hogy több is, de ezt nem tudja megmondani!!!), ezért én a sok countif helyett a like operátort javasolnám:
if range("C11").value="" then range("D11").value=""
else
if hattorf,Győr,Ford,Pors" like "*" & range("C11").value & "*" then ' a felsorolást természetesen ki kell egészíteni - igaz, ha a c11 cella értéke valahol előfordul a megadott szövegben
range("D11").value="OE"
else
endif
endifAz else ágakat az előttem szóló alapján alakíthatod ki.
Üdv.
-
#29302
m.zmrzlina
senior tag
pirit28
#29300
m.zmrzlina
senior tag
válasz
pirit28
#29300
üzenetére
Nem derült ki a kérdésből, hogy melyik cella tartalmát kell módosítania a képletnek ezért én a D11-es cellára írtam meg a makrót.
Próbáld ki jól fejtettem-e vissza a képletet!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("C11").Value = "" Then
Range("D11").Value = ""
ElseIf Range("C11").Value = "*hatroff*" Or Range("C11").Value = "*Győr*" Or Range("C11").Value = "*(OE)*" Then
Range("D11").Value = "OE"
ElseIf Range("C11").Value = "*WH*" Or Range("C11").Value = "*W/H*" Then
Range("D11").Value = "W/H"
Else
Range("D11").Value = "DFC"
End If
End SubA második ág ahogy látod nem teljes, ha így azt csinálja amit szeretnél akkor ki lehet egészíteni.
-
azopi74
addikt
válasz
pirit28
#26023
üzenetére
Szia,
Próbáltad úgy, ahogy mondtam? (hogy C:\ helyett valahova a Users\felhasználónév alá helyezed a cuccot) ?
Mert ez nagyon jogosultság problémának tűnik. Alapból nem nagyon engedné egy Win7/Office 2007 kombó, hogy egy makró a a C:\ -ben garázdálkodjon írási jogosultsággal.
persze ki lehet küszöbölni, ha nagyon akarnád, de nem tenném a helyedben -
Fferi50
Topikgazda
válasz
pirit28
#25772
üzenetére
Szia!
Akkor nálad egyszerre van nyitva a két fájl egyazon alkalmazásban - ezt mutatja a kódod. Bár ettől még mindig nem értem, miért kell új Excel alkalmazást indítani hozzá - hiszen a makró az "anya" alkalmazásban levő munkafüzetben fut és ide hozzá lehetne nyitni a másik két munkafüzetet is. A fromBook és toBook ugyanúgy hozzárendelhető ezekhez itt is. Szerintem műxik a direkt értékadás - csak a tartományokat kell összehangolni, mert ez csak folyamatos egybefüggő tartománynál lehetséges.
Az időingadozás (de főleg a "lefagyás" tünet) oka lehet a hálózati hozzá(nem)férés időszükséglete is.
(Néha az én excelem is csinál ilyet, pedig csak egy gépen van - jól "elszórakozik" saját magával) Az automatikus mentésnek is van ilyen "fagyásosnak tűnő" hatása.Nem lenne baj, ha valahogyan szöveges formában is lehetne látni a kódokat. Ha így lehet látni a kódot, akkor nem tudod a modult exportálni vajon?
Üdv.
-
Fferi50
Topikgazda
válasz
pirit28
#25764
üzenetére
Szia!
Azt szeretném megkérdezni, mi az oka annak, hogy új Excel applikációt töltesz be a program futásához. Annak a betöltése is időt vesz igénybe, másrészt akár befolyásolhatja az időzítőt is (bár ezt nem tapasztalatból mondom).
Ha csak az értékeket szeretnéd átmásolni, akkor "be lehet rántani" egy tömbbe egyszerre az egész tartományt és egybe ki is lehet írni a másik munkalapra, nem kell hozzá ciklus.
dim uploadA()
uploadA=Fsheet.range(cells(1,1),cells(80,36)).value
Tosheet.range(cells(1,1),cells(80,36)).value=uploadAés törölni sem kell a tömb értékét.
De szerintem még annál is gyorsabb a közvetlen értékadás:
Tosheet.range(cells(1,1),cells(80,36)).value=Fsheet.range(cells(1,1),cells(80,36)).value
Hiszen egyébként a két munkafüzeted együtt nyitva van.
Üdv.
-
Fferi50
Topikgazda
válasz
pirit28
#25559
üzenetére
Szia!
Arra tudok gondolni, hogy nem létezik a FilePathL nevű fájl és mivel a hibakezelést visszaadtad a VBA-nak ezért hibával le fog állni.
Az On Error Goto 0 sort szerintem az End If után kell beletenni.
Így a második "nyitási kísérlet után" is meg tudod nézni, hogy sikerült-e a hozzárendelés és le tudod kezelni programból a hibát.If GetFile is Nothing Then
Set GetFile=.....
If GetFile is Nothing Then
ide írhatod, hogy mi legyen ha ez sincs meg
End If
End If
On Error Goto 0Üdv.
-
slashing
senior tag
válasz
pirit28
#25474
üzenetére
A2-ben és B2 lévő cella képleteiben van egy ilyen ;HA(SZÁM(Tábla!A1)=IGAZ cserléd le úgy hogy : (Tábla!A1*1)
ez amúgy azért van mert nem tudom hogyna kerülnek oda az adatok de átveszi a régi cellák cellatípusát és a sima számokat így nem számnak gondolja hanem szövegnek......
de ezt a számos vizsgálatot át kellene írni valami másra mert így a sima 1/10-et meg dátumnak veszi majd... eredetileg ezt a feladatot *-al csináltuk így most a / jel miatt máshogy kell
-
#25469
m.zmrzlina
senior tag
pirit28
#25468
m.zmrzlina
senior tag
-
Delila_1
veterán
válasz
pirit28
#25420
üzenetére
Makróval:
Sub Szetcincal()
Dim adat
If InStr(Selection, "*") > 0 Then
adat = Split(Selection, "*")
Selection.Offset(, 1) = adat(0)
Selection.Offset(, 2) = adat(1)
On Error Resume Next
Selection.Offset(, 3) = adat(2)
Else
Selection.Offset(, 1) = Selection.Value
End If
End SubRáállsz a szétszedendő cellára, és indítod a makrót.
Sajnos saját készítésű függvényt nem lehet rá írni, mert az nem tud a szomszédos cellákba rajzolni. -
slashing
senior tag
válasz
pirit28
#25418
üzenetére
Ha A2-től vannak a szorzások:
A bal képlete: =HA(SZÁM(A2)=IGAZ;A2;BAL(A2;SZÖVEG.KERES("~*";A2)-1)*1)
A közép képlete: =HA(SZÁM(A2)=IGAZ;"";HAHIBA(KÖZÉP(A2;SZÖVEG.KERES("~*";A2)+1;SZÖVEG.KERES("~*";A2;SZÖVEG.KERES("~*";A2)+1)-SZÖVEG.KERES("~*";A2)-1)*1;JOBB(A2;HOSSZ(A2)-SZÖVEG.KERES("~*";A2))*1))A jobb szélével egyenlőre még nem jutottam dűlőre, valaki besegítehne, kezdek belezavarodni a sok szöveg.keresbe....
-
#25419
Fire/SOUL/CD
félisten
pirit28
#25418
-
Fferi50
Topikgazda
válasz
pirit28
#24897
üzenetére
Szia!
Bocs a hosszú hallgatás miatt! Remélem, még aktuális. Próbáld meg ezt:
Sub okesit()
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = CurDir()
If .Show Then
okesito .SelectedItems(1), True
Else
If MsgBox("Nem választottál, befejezed?", vbYesNo, "Könyvtár választás") = vbYes Then Exit Sub
End If
End With
Loop
End Sub
Sub okesito(ByVal konyvtar As String, ByVal alkonyvtaris As Boolean)
Dim fs, fldr, subfldr, fld, fajl As String
Set fs = CreateObject("Scripting.FilesystemObject")
Set fldr = fs.GetFolder(konyvtar)
fajl = Dir(fldr & "\*.xls*")
Do While fajl <> ""
Workbooks.OpenText Filename:=fldr & "\" & fajl
ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
'MsgBox fajl
fajl = Dir()
Loop
If alkonyvtaris Then
Set subfldr = fldr.subfolders
For Each fld In subfldr
fajl = Dir(fld & "\*.xls*")
Do While fajl <> ""
Workbooks.OpenText Filename:=fld & "\" & fajl
ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
'MsgBox fajl
fajl = Dir()
Loop
Next
End If
End SubAz okesit makrót kell elindítani, ott ki tudod választani azt a könyvtárat, amelyben (és alkönyvtáraiban) végre szeretnéd hajtani a műveletet.
Ha a kiválasztott könyvtárban elvégzi a műveletet, akkor visszatér a választó ablak.
A makróból úgy léphetsz ki, hogy a mégse gombot választod, vagy esc-t nyomsz és a kérdésre igent válaszolsz.
Az előrehaladásra nem tettem bele információ kijelzést, a státuszsoron esetleg kiírathatod pl. a kikommentelt msgbox helyére, Application.StatusBar = fajl
akkor a végére pedig Application.StatusBar=FalseÜdv.
-
Fferi50
Topikgazda
válasz
pirit28
#24888
üzenetére
Szia!
Úgy gondolom, az elakadás amiatt van, mert direktben xls kiterjesztésre van kondicionálva:
myfile = Dir(folderName & "\*.xls")
Ha más kiterjesztés is van, akkor így kellene:
myfile = Dir(folderName & "\*.xls*")A mentésnél pedig ezt a sort kellene kiváltanod:
ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".xls", "ok.xls")
úgy gondolom erre:
ActiveWorkbook.SaveAs Filename:= Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
Itt már nem probléma, ha a kiterjesztés pl. xlsx, mert csak az xls cserélődik ki.
A FullName már tartalmazza a teljes elérési utat is, ezért nem kell a folderName hozzá.Üdv.
-
Fferi50
Topikgazda
válasz
pirit28
#24165
üzenetére
Szia!
"="ennyi az idő "&VLOOKUP(B143;$A$19:$D$131;4;0)"
Ez már egy szöveg - szám összefűzés, amire nem érvényes a cellaformátum (mivel az idő az excel számára egy (tört)szám).
Módosíts így
="ennyi az idő "& TEXT(VLOOKUP(B143;$A$19:$D$131;4;0);"időformátum")Az időformátum helyére tedd a neked szükséges formátumot pl. hh:mm.
Üdv.
-
-
bteebi
veterán
válasz
pirit28
#21184
üzenetére
A munkaidőhöz hozzáadni? Nem csak külön a szünetet kellene megszámolni? Talán majd jönnek szebb, egyszerűbb megoldások, de ez működik:
Sub szunet()
Dim i As Integer, lastrow As Integer
lastrow = Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
Cells(i, 4).Value = Cells(i, 3) - Cells(i, 2)
If Cells(i, 2).Value < 8 / 24 And Cells(i, 3).Value > 8 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 30 / 1440
End If
If Cells(i, 2).Value < 10 / 24 And Cells(i, 3).Value > 10 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 10 / 1440
End If
If Cells(i, 2).Value < 12 / 24 And Cells(i, 3).Value > 12 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 10 / 1440
End If
If Cells(i, 2).Value < 14 / 24 And Cells(i, 3).Value > 14 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 10 / 1440
End If
If Cells(i, 2).Value < 16 / 24 And Cells(i, 3).Value > 16 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 10 / 1440
End If
If Cells(i, 2).Value < 18 / 24 And Cells(i, 3).Value > 18 / 24 Then
Cells(i, 4).Value = Cells(i, 4).Value + 30 / 1440
End If
Cells(i, 4).NumberFormat = "[h]:mm"
Next i
End SubA kódban a B és a C oszlopban (2. és 3. oszlop) a 2. sortól van a munkaidő kezdete és vége, és a D (4.) oszlopba írja ki a munkaidő+szünet összegét.
-
Mutt
senior tag
válasz
pirit28
#19100
üzenetére
Hello,
..Szeretném ebből a táblából egy másik táblába kigyűjteni a neveket akik A műszakosak.
Kiindulni az if függvényből indultam el ,úgy hogy megnéztem az illető A műszakos-e vagy B.ezt az R és S oszlopban rögzítettem...
A problémám az az hogyha elfogynak a nevek akkor #num hibaüzenet fogad,amit szeretnél eltüntetni valahogyan, de nem tudom hogyan.
Ezt úgy tudod megoldani, hogy megszámolod hány értéket lehet kiírni, és ha annyit már kiírtál, akkor a semmit iratod ki.A COUNTIF(C:C;"A") megmondja hogy hány értéked van, hogy hányadik írod ki az pedig a SMALL-nál vhogy megadod. Vagyis a képlet vmi ilyen lehet:
=IF(COUNTIF(C:C;"A")<=small-ban a k értéke;eredeti képleted;"")Azonban hadd javasoljak egy másik megoldást is.
Ha nem akarod ABC sorrendben, akkor nem is kell az R és az S segédoszlop, mivel egy képletben meg lehet oldani. Én az alábbi mintával dolgoztam.
Ekkor az E3-ba ez a képlet kell:
=IF(ROWS(E$3:E3)<=COUNTIF($C:$C;E$2);INDEX($B:$B;AGGREGATE(15;6;ROW($C:$C)/($C:$C=E$2);ROWS(E$3:E3)));"")Ezt másolhatod lefele és jobbra is hogy a B műszakosok is meglegyenek.
Ha ABC sorrend is jó lenne, akkor kell egy segédtábla. A mintámban a G és H-oszlopok ezek.
G3-ban ez a képlet:
=IF(COUNTIF($B:$B;"<="&$B3)*($C:$C=G$2)>0;COUNTIF($B:$B;"<="&$B3)*($C:$C=G$2);"")Ez kihasználja azt, hogy a COUNTIF (DARABTELI) függvényben lehet kisebb v. nagyobb operátort is használni, és ezzel sorrendet meghatározni. pl. COUNTF(B:B;"<Dénes") megszámolja hogy Dénes előtt hányan vannak a listában. Szóval a képlet vagy visszaadja az ABC sorrend szerinti helyezést, vagy egy üres mezőt ad.
Ezek után már csak a SMALL segítségével a sorszámokat növekvő sorrendben ki kell olvasni, majd egy MATCH (HOL.VAN) függvénnyel megkeresni, hogy ez hol van és az ahhoz tartozó nevet INDEX-el kiíratni.
A képlet az I3-ban ez:
=IF(ROWS(I$3:I3)<=COUNTIF($C:$C;I$2);INDEX($B:$B;MATCH(SMALL(G:G;ROWS(I$3:I3));G:G;0));"")üdv.
-
Delila_1
veterán
válasz
pirit28
#17744
üzenetére
Bár nem vagyok "úr", azért megpróbálok válaszolni.
Hozd létre a Sheet1 lapon a fényképezőgéppel az objektumot. Ezt másold a Sheet2-re (Ctrl+c, Ctrl+v), és nevezd el Foto2-nek. Kijelölve az új objektumot, a szerkesztőlécen az =$B$1 helyett ezt írd be: =Sheet1!$B$1
A Sheet2 laphoz rendeld a makrót:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = Sheets("Sheet1").Range("A1") Then
F_mutat
Else
F_rejt
End If
End If
End SubÚj modulba másold a lenti 2 makrót:
Sub F_mutat()
Sheets("Sheet2").Shapes("Foto2").Visible = True
End SubSub F_rejt()
Sheets("Sheet2").Shapes("Foto2").Visible = False
End SubHa a Sheet2 lap A1 cellájába beírt név megegyezik a Sheet1 lap A1 cellájának értékével, a Sheet2 lapon látható lesz a fotó, egyébként nem.
-
Delila_1
veterán
válasz
pirit28
#15823
üzenetére
Nem az, amit kértél, de hasonló. Szálkeresztben mutatja a cellát, amire rákattintottál. A laphoz kell rendelned. Nem én írtam.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
With Target
With .EntireRow
.FormatConditions.Add Type:=xlExpression, Formula1:="1"
With .FormatConditions(1)
With .Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With
With .EntireColumn
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="1"
With .FormatConditions(1)
With .Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 36
End With
End Sub -
válasz
pirit28
#15221
üzenetére
Szerintem a legegyszerűbben úgy tudnád megtrükközni, hogyha a napi fájl mindig ugyan azon a néven szerepelne, és az előző napi fájl pedig átneveznéd napi fájlnak:
2012 10. 09.
export aktualis.xls2012 10. 10.
move aktualis.xls backup_2012_10_09.xls
export aktualis.xls2012 10. 11.
move aktualis.xls backup_2012_10_10.xls
export aktualis.xlsígy minden nap csak az összegző fájlt kell frissítened mert a napi fájlnak mindig ugyan az a neve
-
Delila_1
veterán
válasz
pirit28
#14578
üzenetére
A makróban a $A$1 helyére azt a cellacímet írd, amitől megváltozik a SUM értéke, mert a makró a billentyűzetről történő bevitelt figyeli.
Ha egy tartománytól függ az A1 értéke, akkor ilyen legyen a makród:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1:C20")) Is Nothing Then Then Range("C1") = Format(Now(), "hh:mm:ss")
End SubEz a B1:C20 tartományban történt változás következtében írja be a C1-be az időt. Ehelyett add meg a saját összegzendő tartományodat.
-
cousin333
addikt
válasz
pirit28
#14303
üzenetére
Lehet, hogy rosszul értelmezem a leírtakat, de szerintem a megoldás a Rendezés és szűrés. Ez a 2010-es verzióban a Kezdőlap fülön van, a jobb szélén levő Szerkesztés csoportban.
Előtte kijelöld a táblázatot a nevekkel és adatokkal, amiket sorba szeretnél rendezni, majd itt kiválasztod az Egyéni sorrend...-et.
Ha ez megvan, akkor meg tudod mondani, hogy sorokba vagy oszlopokba rendezzen, illetve, hogy mely sorok/oszlopok alapján.
Próbálkozáshoz azért javaslom a biztonsági másolatot.
-
#9341
m.zmrzlina
senior tag
pirit28
#9338
m.zmrzlina
senior tag
válasz
pirit28
#9338
üzenetére
Ha egy név csak egyszer szerepel a listában akkor lehet ez egy megoldás:
Sub find()
eleje:
Cells(2, 3).Activate
amitkeres = InputBox("Add meg a keresni kívánt nevet, vagy név részletet!", "Keresés", amitkeres)
On Error GoTo uzenet
Cells.find(What:=amitkeres, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If ActiveCell.Row <> 2 Then
Cells(2, 3).Activate
GoTo uzenet
End If
Exit Sub
uzenet:
MsgBox ("A keresett név nincs a listában.")
GoTo eleje
End SubNincs bolondbiztossá téve még, csak próbálkozom.
-
#9337
Fire/SOUL/CD
félisten
pirit28
#9335
-
#9336
m.zmrzlina
senior tag
pirit28
#9335
m.zmrzlina
senior tag
válasz
pirit28
#9335
üzenetére
Valami ilyesmire gondolsz?
Private Sub CommandButton1_Click()
Cells(2, 3).Activate
Do Until ActiveCell.Value = ""
amitkeres = InputBox("Add meg a keresni kívánt nevet, vagy név részletet!", "Keresés", amitkeres)
Cells.find(What:=amitkeres, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Loop
End SubInputboxban bekéri a keresendő karaktersorozatot és végigkeresi a C sort az utolsó névig úgy, hogy minden találatnál megáll. <Enter>-rel tudsz a következő találatra ugrani.
Szerintem a munkalapra elhelyezett parancsgombos indítás nem a legcélszerűbb (ennél a megoldásnál biztosan nem). 2007-ben a Gyorsindítás eszköztárba tennék egy parancsgombot, korábbiaknál új menüpontot tennék a menübe.
Melyik Excel verziót használod?
Új hozzászólás Aktív témák
Fferi50- sziku69: Fűzzük össze a szavakat :)
- TCL LCD és LED TV-k
- QNAP hálózati adattárolók (NAS)
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Formula-1
- Mafia: The Old Country - Íme a hivatalos gépigény
- Jól áll az ARM-os Windows helyzete, de a játékoknál nem jön az áttörés
- Kuponkunyeráló
- Nintendo Switch 2
- Sony MILC fényképezőgépcsalád
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Microsoft Windows, Office & Vírusirtók: Akciók, Azonnali Szállítás, Garantált Minőség, Garancia!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- 27%-OS ÁFÁS SZÁMLA I Jogtiszta Microsoft digitális és fizikai termékek I DIGITALKEYZ.COM
- Telefon felvásárlás!! iPhone 16/iPhone 16 Plus/iPhone 16 Pro/iPhone 16 Pro Max
- Targus Universal USB 3.0 DV1K-2K Compact docking station (DisplayLink)
- Gamer PC-Számítógép! Csere-Beszámítás! I5 14400F / RX 6900XT 16GB / 32GB DDR5 / 1TB SSD
- Intel Core i7-8700 / i7-9700 CPU, processzor - Számla, garancia
- GYÖNYÖRŰ iPhone 13 mini 128GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3049, 94% Akkumulátor
Állásajánlatok
Cég: FOTC
Város: Budapest