Hirdetés
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- eBay-es kütyük kis pénzért
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- gban: Ingyen kellene, de tegnapra
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- Klaus Duran: Minden drágul. Vajon a fizetések 2026-ban követi minimálisan?
- Lalikiraly: Asus Gaming V16 - RTX5050
-
LOGOUT
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
-
Delila_1
veterán
Küldöm a másolással, és értékbeillesztéssel kiegészített teszt makrót. Írd át a meghajtó betűjelét!
Sub teszt()
Dim Args As TFindFile, usor As Long, WS As Worksheet
Dim Siker As Boolean, i As Long
With Args
'**************** itt a saját meghajtód nevét írd be! *******
.StartFolder = "F:\"
'****************************************************************
.FileName = InputBox("fájlnév vagy része") & "*"
.Extension = "xlsx"
End With
Siker = FindFile(Args:=Args)
Set WS = ActiveWorkbook.Sheets("Munka1")
If Siker Then
For i = 1 To UBound(Args.Findings)
usor = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open FileName:=Args.Findings(i)
Range("Munka1!A1:L7").Copy
WS.Range("A" & usor).PasteSpecial xlPasteValues
ActiveWorkbook.Close
Next
Else
MsgBox "Nincs találat."
End If
If Args.ErrorCount > 0 Then
MsgBox Args.ErrorCount & " probléma merült fel, lásd Hibák munkalap."
End If
End Sub -
zhari
csendes tag
válasz
Delila_1
#21879
üzenetére
Köszönöm. Szuperül működik.
Másolás résszel még gondban vagyok kb így nézne ki szerintem, de nem jó a beillesztésnél:
...
Sheets("Munka1").Select
Range("A1:L27").Select
Selection.Copy
ActiveWorkbook.Save
ActiveWindow.Close
Windows("02.xlsm").Activate 'gyűjtő füzet
gy_usor = Range("A65536").End(xlUp).Row 'Gyűjtő füzet alsó sora
Cells(gy_usor, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
.... -
DasBoot
aktív tag
válasz
Delila_1
#21892
üzenetére
Húúúú, ez most alaposan megzavart. Mindjárt beírom, aztán tanulmányozom. Addig is: mindig van, mindig kell, hogy legyen szám a szorzó előtt. Mit értesz "Hol a mértékegység" alatt, egyelőre nincsen mértékegység, jelen esetben hertz.
Gyorsan kipróbáltam. Nincsen betű, akkor írja a "Hol a mértékegység?", erre azért gondoltam, hogy így lesz. -
-
gyu84
tag
Sziasztok!
Kis segítségre lenne szükségem Excellel kapcsolatban, a probléma egyszerű, megoldást viszont még nem sikerült rá találnom.
Adott egy összeg amit arányosan felosztok, és %-ban adom meg az arányokat, (pl 15%-25%-40%-20%). Megoldható-e hogy ha változtatok az egyik arányon, akkor változzon vele a többi is, egyenlő arányban növelje vagy csökkentse a többi számot, az összeg nyilván mindig 100% lehet csak.Segítséget előre is köszönöm!
-
DasBoot
aktív tag
Sziasztok, ismét. No, megszületett a kis Jézus
.Elektronikai számítást szeretnék elvégezni, két szám összeszorzását. Egy állandó értéket, egy szorzóval, azaz prefixummal. Frekvenciát számolnék, de ez itt lényegtelen. Kétféle prefix van a „k” és az „M”. A „k”, kiló, 1000-ezerszeres, az „M”, mega, 1000000-szoros szorzást jelent, de gondolom ezt tudjátok, csak pontosan szeretném leírni a tényeket. Mindenképpen úgy akarom, hogy így legyen beírva: 1,234k; 34,915M. Így működik is, még a tizedesvesszővel együtt is.
A probléma a következő. Amennyiben semmilyen szorzót nem írok az állandó után, igencsak elszámolja, nem az az eredmény jön ki, mint aminek kellene. Vannak feltevéseim, hogy miért, de itt kellene a haladó segítség .
Az egészet egy darts számoló alapján készítettem (T, D..), gyakorlatilag ott is egy számot szoroztak egy „betűvel”, aminek megvolt az értéke. Remélem érthetően leírtam, ha szükséges elküldöm magát a táblát is.=SZORZAT(2;PI();HA(SZÖVEG.E(G10);HA(JOBB(G10;1)="k";1000;HA(JOBB(G10;1)="M";1000000
);G10)*HA(VAGY(G10="M";G10="k");1;ÉRTÉK(BAL(G10;HOSSZ(G10)-1))))Az 1000000 után nincsen szóköz, csak a pontosvessző-zárójellel-t szmájli-nak vette.
Az elején van még egy 2pi-szeres szorzó is.Valójában a függvény egyes részleteit nem értem, de éppen ezért kérdezek, szerintem ott akadhattam el, amit nem értek, de ez most lényegtelen. A számolás működjön.Köszönöm a segítséget, üdv.: Yoe
-
DasBoot
aktív tag
Sziasztok! Mint általában sokan, Én is segítséget szeretnék kérni. Egyszer majd Én is tudok adni tanácsot
. Sokat foglalkozok az MSExcel-el, de nem elegek az ismereteim, a problémám inkább haladó. Elkezdtem, de lett egy pont ahonnan nem tudok tovább lépni. Remélem majd a későbbiekben tud valaki segíteni. Egyelőre csak magát a függvényt másolom be, aztán majd leírom részlétesen a feladatot. Egy fontos dolog, hogy nem makróval szeretném megoldani. Íme a függvény, remélem nem elriasztó: =SZORZAT(2;PI();HA(SZÖVEG.E(G10);HA(JOBB(G10;1)="k";1000;HA(JOBB(G10;1)="M";1000000; ));G10)*HA(VAGY(G10="M";G10="k");1;ÉRTÉK(BAL(G10;HOSSZ(G10)-1)))) -
csenor
senior tag
Sziasztok!
Csináltam egy táblázatot leginkább a Ha függvény felhasználásával ami Vb-hez.
Beírom az eredményt és automatikusan tölti kifelé a táblázatot (győzelem, lőtt gól stb.).
Hogy tudnám megoldani, hogy az elért pont alapján automatikusan sorba rendezze a csapatokat (a sorokban lévő képletekkel együtt)!? -
-
bteebi
veterán
válasz
Delila_1
#21880
üzenetére
Nagyon köszönöm a segítséged, működik!
Először amúgy valamiért nem akart menni, de aztán modulba raktam, és utána már lefutott. Kell neki a modul, vagy valami más gond lehetett először szerinted?Az is fura amúgy, hogy ha a
Sheets(lap%).Select
Range("E10").Select
részt összevonom így: Sheets(lap%).Range("E10").Select, akkor megint csak nem megy ("Range osztály Select metódusa hibás"). Pedig szokott működni ez az összevonás... -
Delila_1
veterán
válasz
bteebi
#21878
üzenetére
Sub osszeir()
Dim lap%, tartomany As Range, CV As Range
Dim oszlop As Integer, betu As String
For lap% = 1 To Sheets.Count
If Sheets(lap%).Name <> "osszeir" Then
Sheets(lap%).Select
Range("A5").Select
Set tartomany = Selection.CurrentRegion
For Each CV In tartomany
Debug.Print CV.Address
If CV.Interior.ColorIndex = 3 Then
betu = Cells(6, CV.Column)
If CV.Column Mod 2 = 0 Then
oszlop = CV.Column
Else
oszlop = CV.Column - 1
End If
Sheets("osszeir").Range(CV.Address) = "0" & Cells(5, oszlop) & "-" & _
betu & "-" & Cells(CV.Row, 1) & "h"
End If
Next
End If
Next
Sheets("osszeir").Select
End Sub -
Delila_1
veterán
Nem tudtam megírni, egy régi kedves barátom segített ki.
A teszt makróban a .StartFolder = "F:\" sorban írd át a meghajtó nevét a sajátodra, majd a ciklusban a jelzett részbe tedd be a másolást, és a megnyitott fájl bezárását. Ezt makrót kell indítanod. Bekéri a keresendő fájlok nevének azt a részét, ami közös, a példád szerint ez valami. A státuszsorban megjelennek a mappák, almappák, ahol a valami kezdetű fájlneveket keresi.
Public Type TFindFile
StartFolder As String
FileName As String
Extension As String
Findings() As String
ErrorCount As Long
End TypeFunction FindFile(Args As TFindFile) As Boolean
Dim Folders() As String, CurrentFolder As String, FolderLevel As Long
Dim FN As String, LookUpName As String
Dim i As Long, Maxi As Long, Mini As Long, FileFound As Boolean
Dim Rng As Range
With Args
ChDrive Left(.StartFolder, 1)
If Right(.StartFolder, 1) <> "\" Then .StartFolder = .StartFolder & "\"
ReDim Folders(1)
Folders(1) = .StartFolder
FolderLevel = UBound(Split(.StartFolder, "\"))
LookUpName = .FileName & "." & .Extension
End With
ReDim Args.Findings(0)
Mini = 1
On Error GoTo hiba
Do
Maxi = UBound(Folders)
For i = Mini To Maxi
FN = Dir(Folders(i) & LookUpName, vbNormal)
While Not FN = ""
FileFound = True
ReDim Preserve Args.Findings(UBound(Args.Findings) + 1)
Args.Findings(UBound(Args.Findings)) = Folders(i) & FN
FN = Dir()
Wend
If UBound(Split(Folders(i), "\")) = FolderLevel Then
FN = Dir(Folders(i) & "*.*", vbDirectory)
While Not FN = ""
If (FN <> ".") And (FN <> "..") Then
If (GetAttr(Folders(i) & FN) And vbDirectory) <> 0 Then
FN = Folders(i) & FN & "\"
ReDim Preserve Folders(UBound(Folders) + 1)
Folders(UBound(Folders)) = FN
Application.StatusBar = FN
End If
End If
FN = Dir()
Wend
End If
DoEvents
Next
Mini = Maxi
FolderLevel = FolderLevel + 1
Loop Until Maxi = UBound(Folders)
If FileFound Then FindFile = True
Application.StatusBar = False
Exit Function
hiba:
Set Rng = Sheets("Hibák").Range("A" & Rows.Count).End(xlUp).Offset(1)
With Rng
.Value = Folders(i)
.Offset(, 1) = FN
.Offset(, 2) = Err.Description
.Offset(, 3) = Err.Number
End With
Args.ErrorCount = Args.ErrorCount + 1
Resume Next
End FunctionSub teszt()
Dim Args As TFindFile
Dim Siker As Boolean, i As Long
With Args
'**************** itt a saját meghajtód nevét írd be! *******
.StartFolder = "F:\"
'****************************************************************
.FileName = InputBox("fájlnév vagy része") & "*"
.Extension = "xlsx"
End With
Siker = FindFile(Args:=Args)
If Siker Then
For i = 1 To UBound(Args.Findings)
Workbooks.Open FileName:=Args.Findings(i)
'****************************************************************
' ide jön a másolás, majd a behívott fájl bezárása
'****************************************************************
Next
Else
MsgBox "Nincs találat."
End If
If Args.ErrorCount > 0 Then
MsgBox Args.ErrorCount & " probléma merült fel, lásd Hibák munkalap."
End If
End Sub -
bteebi
veterán
válasz
PistiSan
#21877
üzenetére
Kiindulásnak ez bőven jó, de ez se rossz. Ez pedig egy nagyon rövid összefoglaló. Ha komolyabban is érdekel, akkor ezt a könyvet érdemes lehet beszerezned. Amúgy rengeteg segédlet van a neten (elsősorban angolul persze), többek között a Youtube-on is, érdemes keresgélni.
Erre esetleg lenne valakinek ötlete? Közel vagyok a megoldáshoz, de sajnos nem tudom, hogy hol van a hiba.
-
pigster
senior tag
válasz
cirkus
#21862
üzenetére
Ilyesmire gondoltál? (Google: "excel vlookup array multiple results")
http://www.get-digital-help.com/2009/10/25/how-to-return-multiple-values-using-vlookup-in-excel/
http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=119:vlookup-multiple-values-return-multiple-corresponding-values-for-one-lookup-value&catid=77&Itemid=473
-
Mittu88
senior tag
válasz
PistiSan
#21869
üzenetére
Egy ciklust rakj bele.
Ezt így be is másolhatod:Sub Makró7()
'
' Makró7 Makró
''
Dim i as integer 'Deklarálod, tehát létrehozod a változóti=0 'értékadás i változónak
For i = 1 to 200 '1-től 200 oszlopig vizsgálja, egyesével lépked
Columns( i ).Select 'i-edik oszlopot kiválasztja
ActiveSheet.Range( i ).RemoveDuplicates Columns:=1, Header:=xlNo 'ezt nem tudom működni fog-e
i = i + 1 'növeli 1-gyel i értékét, hogy a következő oszlopra lépjen
Next 'Ciklus végeEnd Sub
-
PistiSan
addikt
válasz
Mittu88
#21868
üzenetére
Olyan 300 oszlopom van, kb 80-100 cellányi tartalommal.
Az oszlopon belül van jó néhány cella ami üres, ezért az CTRL+SHIFT Nyil problémás.Rögzítettem egy excel makrót, így néz most ki.
Sub Makró7()
'
' Makró7 Makró
'
'
Columns("P:P").Select
ActiveSheet.Range("$P$1:$P$101").RemoveDuplicates Columns:=1, Header:=xlNo
End SubHa átírom a "P" oszlopot mondjuk Q-ra, akkor szépen lefut ott is, de ez elég macerás, azt gondolnám hogy valami módon lehet egy változót megadni, ami mondjuk "LH"-ig megcsinálja ezt helyettem.
Tök jó volna, ha több oszlopot kijelölve is eltávolítaná az ismétlődéseket, de sajnos nem teszi.
-
Mittu88
senior tag
válasz
PistiSan
#21867
üzenetére
Nem tudom hány oszlop van, de ha csak pár (20-30), akkor pl. B1 cellára állva ha nyomsz egy CTRL+SHIFT+lefele nyíl kombót, vágólapra helyezed (ctrl+c), utána az A1-re kattintasz, nyomsz egy CTRL+lefele nyilat (utolsó kitöltött cellához ugrik), utána még egy lefele nyilat és ezután beilleszted (ctrl+v), akkor a B oszlop tartalma máris át van helyezve az A-ba.
És így tovább. Nagyon macerás?
Mert szerintem csak makróval lehet automatizálni, de nem érdemes programot írni pár oszlop miatt.
-
PistiSan
addikt
Sziasztok!
Excelben lehet olyat, hogy az összes oszlop tartalmát az első oszlopba másolom egymás alá?Van egy jó nagy táblázatom, oszloponként rakás adattal, el szeretném távolítani az ismétlődéseket, sajnos oszlopon belül működik csak, több oszlopot kijelölve nem távolítja el.
-
Geryson
addikt
Sziasztok! Lehet, hogy hülyeséget fogok kérdezni, de nem értek valamit.
A SZUMHATÖBB függvényt szeretném használni (sőt, használom elég régóta), de valahogy most elkezdett egy furcsaságot okozni. Ez a függvény úgy működik, ha a kritériumok mindegyike érvényesül, csak akkor hoz eredményt? Nekem az kellene, hogy ha az egyik kritérium megvan, akkor is hozza és akkor is ha pl. csak a másik.
-
zhari
csendes tag
Sziasztok!
Végső célom az, hogy egy adott mappa almappáiból meghatározott nevű "cica_*.xlsx"-ek (* természetesen változik) állandó munkalapnevű (munka1) lapokról adott tartományokat egy új táblába egymás alá szeretnék másolni.
Van pár elvileg működő script amiket szeretnék egyesíteni, de nem jön össze.Sub makrófuttatás_almappákban()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As WorkbookApplication.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = FalseOn Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\...\egyéb\makrók\teszt"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
'Optional filter with wildcard
'.Filename = "cica*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(filename:=.FoundFiles(lCount), UpdateLinks:=0)'DO YOUR CODE HERE
Range("A1").Select
ActiveCell.FormulaR1C1 = "=2"wbResults.Close savechanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "kész"
End SubA fentivel az a bajom, hogy nem tudom meghatározni, hogy milyen nevű táblákkal dolgozzon és mintha nem jó táblákon indítaná a makrót.
Egy másik script ugyanerre:
Sub makrófuttatás_almappákban()
Dim folderPath As String
Dim filename As String
Dim wb As WorkbookfolderPath = "C:\...\egyéb\makrók\teszt" 'change to suit
If Right(folderPath, 1) <> "" Then folderPath = folderPath + ""
filename = Dir(folderPath & "cica2*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)'Call a subroutine here to operate on the just-opened workbook
Range("A1").Select
ActiveCell.FormulaR1C1 = "=2"
filename = Dir
Loop
Application.ScreenUpdating = True
MsgBox "kész", vbInformation
End SubA fentiek valamelyikét szeretném egyesíteni a következő scripptel.
Sub Fésü()
Const utvonal = "C:\...\egyéb\makrók\teszt" 'Ezt írd át arra a mappára, ahol az xls-eid vannak
Dim FN As String, WB As WorkbookChDir utvonal
FN = Dir(utvonal & "D01_*.xls", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
usor = Range("A65536").End(xlUp).Row 'Behívott füzet alsó soraWindows("02.xlsx").Activate
gy_usor = Range("A65536").End(xlUp).Row 'Gyűjtő füzet alsó soraWindows(FN).Activate 'Behívott füzet
Range(Cells(1, 1), Cells(usor, 12)).Copy 'A
oszlop (1:4)Windows("02.xlsx").Activate 'Gyűjtő füzet
Cells(gy_usor, 1).Select
ActiveSheet.Paste
Windows(FN).Activate 'Behívott füzetActiveWorkbook.Save
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
End SubRemélem érthető volt a problémám. Minden hozzászólást szívesen fogadok.
-
bteebi
veterán
Sziasztok!
Adott a képen látható táblázat. Adott háttérszínű (mondjuk piros, de igazából lényegtelen) cellához tartozó sorok, oszlopok neveit szeretném összefűzni. Az 5. sorban (2 cellánként) számok vannak "00" formátummal, a 6. sorban pedig ehhez tartozó azonosítók, az A oszlopban pedig időpontok. Tehát ha mondjuk a "G9" cella piros hátterű lenne, akkor az összefűzött név úgy nézne ki, hogy 03-B-2.00h. Ezeket az összefűzött neveket egy külön lapra ("osszeir") szeretném kigyűjteni egymás alá. Több munkalapon is van ilyen táblázat. Az általam írt makró valamiért sajnos nem működik. Egyelőre itt tartok:
Sub osszeir()
Dim lap%, i As Integer, cella As Range, tartomany As Range
i = 1
For lap% = 1 To Worksheets.Count
Sheets(lap%).Activate
If Sheets(lap%).Name <> "osszeir" Then
Set tartomany = ActiveSheet.UsedRange
For Each cella In tartomany
If cella.Color.Interior = 255 Then
Sheets("osszeir").Cells(i, 1).Value = ActiveSheet.Cells(5, Int(cella.Column / 2) * 2) & "-" & ActiveSheet.Cells(6, cella.Column) & "-" & ActiveSheet.Cells(cella.Row, 1) & "h"
i = i + 1
End If
Next cella
End If
Next lap%
End SubMeg tudnátok mondani, hogy mi lehet a gond? Valószínűleg a cella.Column nem (se) tetszik neki, viszont nincs ötletem, hogy hogy lehetne máshogy megírni. Nagyon köszönöm a segítségeteket!
-
pigster
senior tag
-
pigster
senior tag
válasz
Delila_1
#21845
üzenetére
Hú, látom nagyon beleástad magad, köszi!
Úgy tűnik, hogy tizedesvesszőhöz igazodnak, pedig nem. Nagyobb szövegméretnél, meg "exotikusabb" betűtípusoknál (Algerian, de akár Arial Black is) látszik, hogy mégsem. Legalábbis nekem nem. Mindegy, majd azt gondolom, hogy tényleg egymás alatt vannak... -
Delila_1
veterán
válasz
pigster
#21841
üzenetére
Formátum a vonal eltüntetéséhez: # ###_,_— (alsó kötjel, vessző, alsó kötjel, 0151)
A képlet marad az előbbi.A formátumnál az alsó kötjel után megadott karakter szélességének megfelelően ad egy jobb oldali behúzást.
Például a 0,0_W a bevitt szám mögött egy W-nek megfelelő szélességű üres helyet hagy.Itt két karakterrel, a vesszővel, és a hosszú kötjellel kell behúzni, mindegyikhez külön be kell írni az alsó kötjelet.
-
-
pigster
senior tag
Köszi.
Ez eddig ok is lenne, de csak akkor működik, ha ténylegesen ott van a szám is, tehát pl:
1,234
12,34
123,4Ezeket szépen tizedesre igazítaná
De az én problémám az lenne, hogy hogyan lehetne ezt úgy megoldani, hogy ebben az esetben is tizedesre igazodjon, az elsó szám az az előzőekben megfejtett feltételes formátum miatt nézzen így ki, tehát egész számnál ne 00-t írjon ki a tizedesekhez, hanem "--". Ennek a formátumkódja meg "# ##0,--". Ezt meg sehogy sem sikerült összehozni a kérdőjellel.:123,--
1,23
12,30
Na, szóval ilyesmi kéne, de úgy, hogy ne kelljen monospace karaktert beállítani Excelben (Lucida Console, Courier New stb)
illetve:
Ha egész szám van megadva, akkor még sikerült megoldanom, hogy semmit se írjon kia tizedesekhez, de a nyamvadt tizedesvesszőt ekkor is kiteszi. El lehet tüntetni vhogy, hogy egész értékeknél ne jelenjen meg a tizedesveszző, de mégis ahhoz igazodjon így?123
1,23
12,30 -
-
pigster
senior tag
Lehetséges olyan számformátum létrehozása (esetleg vmilyen feltételes formázás), ami így jeleníti meg a számokat:
Beírt (számított) adat ---> megjelenik:
123,5 ---> 123,50
123 ---> 123,--
Magyarul, kettő tizedesre kerekít, de ha egész számról van szó, akkor a
,00 helyett ,--
jelenjen meg -
Delila_1
veterán
válasz
toth60
#21831
üzenetére
A lapvédelem előtt add meg a háttérszínt az összes cellának. A makró a védett tartomány hátterét fehérre állítja a védelemmel azonos időben.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
Rows(Target.Row).Locked = True
Range("A" & (Target.Row) & ":E" & Target.Row).Interior.Color = vbWhite
End If
End Sub -
Delila_1
veterán
válasz
toth60
#21828
üzenetére
Én vagyok a hibás. Az 1. pontban nem írtam meg, hogy az írható cellák zárolását vedd le, akkor már nem lesz hiba.
Ha azt akarod, hogy az 5. (E) oszlopba írás után legyen a teljes sor zárolt, akkor az A:E oszlopok celláinak a zárolása elől vedd ki a pipát a cellaformázásnál, a makró pedig a laphoz rendelve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
Rows(Target.Row).Locked = True
End If
End SubA makró bemásolásakor írd át az aaa jelszót a saját jelszavadra.
-
toth60
csendes tag
válasz
Delila_1
#21827
üzenetére
Ez eddig szuper,köszi szépen...csak most minden egyes cella beíráskor le kell venni a lapvédelmet !
Konkrétan a problémám:
egy olyan excelt kell használnunk, amibe ha 1x egy cellába/sorba beír valaki, azt ne lehessen megváltoztatni többé, csak olvasni ( a példádban a lapvédelem felszabadítása után bármelyik cellát lehet módosítani a tartományon belül is, én pont ezt szeretném elkerülni!)
Tehát egy felhasználó rögzít egy sort a táblában (pl. 5 cellát), majd utána mentéskor ennek a sornak kellene zárolódni, azért hogy a leírtakat ne lehessen megváltoztatni csak olvasni és így menne tovább minden bejegyzés!
Biztos én nem magyaráztam el a problémámat érthetően, bocsi érte! -
Delila_1
veterán
válasz
toth60
#21826
üzenetére
1. Jelöld ki együttesen a cellákat, amikbe engeded a beírást. Ezt például a Ctrl billentyű nyomva tartása mellett a cellákra kattintással teheted meg.
2. Adj nevet a kijelölt területnek, legyen a név zárolni.
3. Védd le a lapot. A védelemnél a Zárolt cellák kijelölése elől vedd ki a pipát, a Nem zárolt cellák kijelölése legyen kijelölve. Nálam a jelszó aaa, ehelyett vigyél be valami mást.
4. Lapfülön jobb klikk, Kód megjelenítése. Bejutottál a VB szerkesztőbe, ahol a jobb oldali üres felületre másold be a lenti makrót.
5. Írd át az
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
sorban az aaa-t a saját jelszavadra, indulhat a munka.Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
If Not Intersect(Target, Range("zárolni")) Is Nothing Then Range(Target.Address).Locked = True
End Sub -
toth60
csendes tag
Én is segítségre szorulok:
Meg lehet(ne) azt egy(vagy több) cellával tenni, hogy a beleírás után zárolja (ne lehessen többet beleírni) és csak egy jelszóval lehessen újra szerkeszteni?
Jelen pillanatban csak kézi zárolással tudom ezt megoldani, de jó lenne ezt ha az excel automatikusan elvégezné!
Nagyon hálásan köszönök minden segítséget! -
lappy
őstag
Szia!
Az első részre a megoldás:
Sub Open_My_Files()
Dim MyFile As String
MyPath = " M:\Access Files\ "
MyFile = Dir(MyPath)
Do While MyFile <> ""
If MyFile Like "*.xls" Then
Workbooks.Open MyPath & MyFile
Sheets(1).Select
Range("C3") = 6
ActiveWorkbook.Close True
End If
MyFile = Dir
Loop
End SubA második részre meg szerintem találsz itt is a fórumon leírást, a kettőt már csak össze kell tenni és kész.
-
bagira82
csendes tag
válasz
Delila_1
#21817
üzenetére
Szia,
A megoldásodat az alábbira formáltam. Hogyan tudnám meghatározni, hogy mennyi ilyen Tomb változó keletkezett? A lényege az egésznek az lenne, hogy a vesszőig beolvasott karaktereket az "a"változóban tárolnám, addig, amig egy másik munkalapon megkeresem az "a" változóban lévő értéket. Utána jöhet a következő vessző előtti 10 vagy 11 karakter, amit szintén "a" váltzóban tárolnám, és ez az egész addig megy, amíg el nem fogynak a karakterek a cellában.
Do
lep = ActiveSheet.Cells(i, 4).Value
Dim Tomb
Tomb = Split(ActiveSheet.Cells(i, 4).Value, ",")Do
a = Tomb(j)
j = j + 1
Loop Until Tomb(j) = Empty ' HIBAÜZENET ITT (subscript out of range)i = i + 1
Loop Until lep = Empty
Köszi
-
bagira82
csendes tag
Sziasztok
Excel makró írásban szeretném újra a segítségeteket kérni:
Van egy cellám, aminek a tartalma pl.: a következő:
155367A-01L,193135D-01,193135E-01L
Hogyan tudnám a vessző előtt lévő 11 vagy 10 karaktereket beolvasni jelen esetben 3 (a, b, c) változóba?
Köszi szépen előre is!
Üdv
Jani -
sziasztok!
van több, ugyanolyan hosszú adatsorom, és ezekből ugyanolyan hosszú részleteket szeretnék megjeleníteni két diagramon, az egyiken 4 adatsor van, a másikon pedig 3. azt szeretném megoldani, hogy egy inputboxban definiálom az adatsor elejét és végét, a makró pedig frissítse ezáltal a diagramokon az adatsorokat.
köszönöm a segítséget!
-
Delila_1
veterán
válasz
David888
#21812
üzenetére
Szia!
A verseny lap D4-es cellájában a képlet
=INDEX(iskola!A:D;HOL.VAN(D4;iskola!D:D;0);1)A súgóból:
Szintaktika: INDEX(tömb;sor_szám;oszlop_szám)
Táblázat vagy tömb azon elemének értékét adja vissza, amelyet a sorszám és oszlopszám mint index meghatároz.A képletben a sor_számot a HOL.VAN függvénnyel határoztam meg, ahol pontos értéket kerestem (az utolsó paraméter 0). Az oszlop_szám értéke 1, mert az iskolák nevét az első oszlop tartalmazza.
Így is lehetett volna:
=INDEX(iskola!$A$1:$D$5;HOL.VAN(D4;iskola!D:D;0);1)
Ha az iskola lapon nem a teljes A oszlopot adom meg, akkor a tartományt fixen kell megadni, erre szolgálnak a $ jelek. -
David888
tag
Sziasztok!
Ezekkel a feladatokkal lenne gondom, valaki legyen szíves segítsen, mert nagyon szeretnék átmenni táblázatból :S
A H1 cella tartalma: „Átlagos súly”. Alatta jelenjen meg az egyes iskolák nevében induló kutyák átlagos testsúlya! Az eredmény egy tizedes jegyre kerüljön kiírásra!
A K3 cellába írd be „Iskola neve”! Alatta jelenítsd meg. hogy melyik kutya, milyen nevű iskolából jött! A megoldáshoz használd fel az „iskola” munkalap adatait, de azokat nem másolhatod (nem szervezheted át) a megoldásod érdekében!
http://www28.zippyshare.com/d/85874890/2184/05_tablazat.xlsx
Előre is köszönöm nektek!!!
-
zhari
csendes tag
Szeretnék egy olyan macrót mely megnyitja az adott elérési út összes almappájából (C:\...\mappanév ) az összes aaa_yyyy.yy.yy.xlsx (y változik, aaa_ állandó) tábláját és ezen táblák minden "Munka1" nevű munkalapok L1 celláit és A4:L14 tartományait egymás alá másolja.
Tehát az első L1 menjen A1-be és az A4-L14 menjen B1-M12-be.
Második tábla L1 cellája A13-ba és az A4-L14 menjen B13-M24-be.Szép napot.
-
klambi
addikt
Szevasztok!
Olyan gondba ütköztem, amikor 2-3 vagy több excel ablak van nyitva win 7 alatt, a tálván látszik az ikonra helyezve az egeret ugye egy kis view ablakban megjelennek a megnyitott táblák. Azonban ha így szeretnék ablakot váltani nem engedi, egyszerűen nem vált ablakot, csak alt tab os megoldással, azonban ez eléggé kényelmetlen és lassú.
Van valakinek ötlete, hogy ezt hogyan, mivel lehet orvosolni?
(egyszer csak megjelent ez a hiba egyik napról a másikra...) -
Caipi
tag
válasz
KaiotEch
#21802
üzenetére
Szia,
A példád nem teljesen világos számomra, ha jól értelmeztem, akkor 3 oszlopban vannak az adataid. Ezeket szeretnéd összesíteni, úgy, hogy amennyiben az első két oszlopban azonos adatok szerepelnek, akkor a harmadikban szereplő számokat adja össze.
Ezt a szumhatöbb() függvény el tudja végezni neked.
A Sheet2-n létre kell hoznod egy listát az első két oszlop adataiból, amely csak egyedi értékeket tartalmaz, majd erre kell alkalmazni a függvényt.
Pl:
Sheet2 első két oszlopa az adat, harmadik oszlop függvénye: A1&B1. Ez a két oszlop celláiban szereplő értékeket összefűzi egybe. Ebből már ki tudod szedni az egyformákat. Az excel Adatok/ismétlődések eltávolítása segítségével. A maradék mellé kell a szumhatöbb().Üdv,
Caipi -
Sziasztok. Helpet szeretnék kérni. Van egy jó nagy táblám, amiben vannak felvéve ID alapján adatok ami mellé van írva egy érték.
Pl:
0001 | Kiss Józsi | 111
0001 | Kiss Józsi | 222Nos milyen függvénnyel tudnám ezeket összeadni? Tehát, hogy mondjuk a Sheet2-n jelenjen meg úgy(csak egyszer), hogy:
0001 | Kiss Józsi | 333
.
);G10)*HA(VAGY(G10="M";G10="k");1;ÉRTÉK(BAL(G10;HOSSZ(G10)-1))))
Először amúgy valamiért nem akart menni, de aztán modulba raktam, és utána már lefutott. Kell neki a modul, vagy valami más gond lehetett először szerinted?
oszlop (1:4)
Új hozzászólás Aktív témák
Fferi50- Képregény topik
- Otthoni hálózat és internet megosztás
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Horgász topik
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Azonnali informatikai kérdések órája
- Honor Magic V5 - méret a kamera mögött
- Nem tudom a dal címét, előadóját
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- PROHARDVER! feedback: bugok, problémák, ötletek
- További aktív témák...
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest