-
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
-
Delila_1
Topikgazda
válasz Fire/SOUL/CD #8508 üzenetére
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 Fire/SOUL/CD #8510 üzenetére
Látszana is, ha oda is lehúztam volna a képletet...
Ezzel a képlettel megkapod a C-ben az E oszlop tartalmát. Ennek szerintem nem sok értelme van. A kérdező a B oszlopban lévő névhez tartozó címet szeretné látni.
Most csak megdupláztad az E tartalmát.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 Fire/SOUL/CD #8512 üzenetére
Ez most egy akadémista vita, mert rTyler a B oszlop tagjaihoz szeretné rendelni a címe(ke)t.
Ha csak az érdekelné, hogy a D tagjai szerepelnek-e a B-ben, egy feltételes formázással, képletek nélkül megtehetné.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 Fire/SOUL/CD #8514 üzenetére
Benne maradt az eredeti
=HA(HIBÁS(FKERES(B1;D:D;1;0));"-";FKERES(B1;D:E;2;0))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 IReTrOI #8515 üzenetére
Kellene az elrendezésről egy kép, mert első olvasásra úgy tűnik, 2 adatot akarsz 1-1 oszlophoz rendelni, a félévek számát, és a képzés típusát. Ezeket össze lehet vonni két FKERES függvénnyel.
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
Az a másik cella lehetőleg másik lapon legyen, a példában a Munka2 lap A1 cellájában van.
Sub MentésTxtbe()
Application.DisplayAlerts = False
utvonal = "D:\Adatok\2010\"
FN = utvonal & Sheets("Munka2").Range("A1").Value
ActiveWorkbook.SaveAs Filename:=FN, FileFormat:= _
xlTextMSDOS, CreateBackup:=False
Application.DisplayAlerts = True
End SubAz utvonal változóhoz add meg a saját mentési útvonaladat.
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 Robb202 #8536 üzenetére
Makró és ComboBox nélkül:
A kérdéses cellán állva Adatok/Adateszközök/Érvényesítés. Megengedve Lista, a Forráshoz eladva; raktáron; szállítás.
Továbbra is a cellán állva Kezdőlap/Stílusok/Feltételes formázás/Cellakijelölési szabályok/Egyenlő. Ide beírod az eladva szót, hozzárendeled a megfelelő formátumot a legördülőből. Ugyanezen az úton megadod a másik két szóhoz is a kellő formátumot.
Mód.:Ez 2007-re vonatkozik, valószínű, hogy nem változtattak ezen a lehetőségen a 2010-ben.
[ 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.
-
Delila_1
Topikgazda
2003-as verziónál az Alt+F8-cal behívod a Makró menüt, kiválasztod a módosítandó makrót, és az Egyebek gomb segítségével előcsalod a bill. hozzárendelést.
Szerk: megnéztem, ugyanez 2007-ben is igaz.
[ 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.
-
Delila_1
Topikgazda
Ulrik cellaformátuma úgy írja ki az értékeket, ahogy szeretnéd.
A cellaformázásnál az Egyéni kategóriában a Formátumkódhoz másold be ahhoz a cellához, amelyikbe az 1440-nel való osztást vitted be:
n "nap," ó "óra," p "perc"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 pentium4 #8589 üzenetére
2003-as verzióban: állj a rögzíteni kívánt oszlop mögötti, és a rögzítendő sor alatti első cellába, Nézet/Ablaktábla rögzítése.
A rögzítés után a Ctrl+Home erre a cellára állítja a fókuszt.
Megszüntetés: Ctrl+Home billentyűkkel erre a cellára állsz, Nézet/Ablaktábla feloldása.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 Fire/SOUL/CD #8593 üzenetére
Köszönöm. A topic pangott, ill. mire észrevettem egy kérdést, már válaszoltatok is.
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 medium84 #8596 üzenetére
Ezt a makrót abba a füzetbe másold be, ahol a 2 oszlopod van. Feltételeztem, hogy mindkét füzeted első lapján vannak az adataid. A makróban írd át a füzetek nevét (Elso, Masodik).
Sub Megjelol()
Dim sor As Integer, usor As Integer
Dim serial, c
sor = 2: usor = ActiveSheet.UsedRange.Rows.Count
For sor = 2 To usor
serial = Cells(sor, 1).Value
Windows("Masodik.xls").Activate
With Range("A:A")
Set c = .Find(serial, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
Cells(c.Row, 1).Font.ColorIndex = 3
Windows("Elso.xls").Activate
Range(Cells(sor, 1), Cells(sor, 3)).Font.ColorIndex = 3
Cells(sor, 2).FormulaR1C1 = "=VLOOKUP(RC[-1],[Masodik.xls]Munka1!C1:C2,2,0)"
Cells(sor, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],[Masodik.xls]Munka1!C1:C3,3,0)"
End If
End With
Windows("Elso.xls").Activate
Next
Range("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(1).Select
Application.ScreenUpdating = True
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.
-
Delila_1
Topikgazda
A 2-es kérdésre:
Sub Utvonal()
Dim Utvonal As String, Fajlnev As String
Utvonal = InputBox("Mi legyen az útvonal?", "Útvonal kiválasztása", Default)
Fajlnev = InputBox("Melyik fájlt nyissam meg?", "Fájlnév megadása", Default)
Workbooks.Open Filename:=Utvonal & "\" & Fajlnev & ".xls"
End SubFire
Tényleg kimaradt a képernyőfrissítés letiltása , jó, hogy észrevetted.
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 Vizes Tomi #8613 üzenetére
Vegyél fel egy új oszlopot, ahova a HÓNAP függvény segítségével beíratod az A oszlop hónapjának a számát, és erre az oszlopra hivatkozz a SZUMHATÖBB-bel.
Szóba jöhet még a SZOZRATÖSSZEG függvény is a megoldáshoz.
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 Vizes Tomi #8616 üzenetére
Nincs mit.
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
Úgy vélem, hogy az átalakítandó celláid szöveg formátumú számjegyeket tartalmaznak. Egyszerűbben is átalakíthatod az egészet.
Valahova egy üres cellába beírsz egy 1-est, másolod. Kijelölöd a kérdéses tartományt, jobb klikk, Irányított beillesztés, Szorzás. Az 1-esre már nincs szükség, törölheted. Ennyi.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 Mike318 #8663 üzenetére
Az End-nek mindig tartalmaznia kell, minek a végét jelöli. A Select Case vége End Select, mint ahogy párosan szerepel az If és End If, vagy a Sub és End Sub.
Ha a példádban a subrutinból akarsz kilépni, akkor Exit Sub kell az End helyett.
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
Régen leveleztünk, biztos a régi címemmel próbálkoztál. Inkább beírom ide a kódot. A füzetet, amiben most 1 lapon vannak az adatok, Eredeti.xls-nek neveztem el, az újat, amit a makró hoz létre, UjFuzet.xls névvel illettem.
Az útvonalat az első sorban írd át.Sub SokLap()
Const utvonal As String = "F:\Eadat\"
Dim lapsz As Integer, lap As Integer
Dim lapnev As String
lapsz = Range("A" & Rows.Count).End(xlUp).Row
Application.SheetsInNewWorkbook = lapsz - 1
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=utvonal & "UjFuzet.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("Eredeti.xls").Activate
For lap = 2 To lapsz
lapnev = Cells(lap, 1)
Workbooks("UjFuzet.xls").Sheets(lap - 1).Name = lapnev
Rows(1).EntireRow.Copy Workbooks("UjFuzet.xls").Sheets(lapnev).Rows(1)
Rows(lap).EntireRow.Copy Workbooks("UjFuzet.xls").Sheets(lapnev).Rows(2)
Next
Windows("UjFuzet.xls").Activate
For lap = 1 To lapsz - 1
Sheets(lap).Select
Range("A1:I2").Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Next
Application.SheetsInNewWorkbook = 3
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.
-
Delila_1
Topikgazda
Nézd meg a 8110-es kérdést, ugyanerről szól.
Javaslom, hogy keresd meg levélben bnorci71-et, a kérdés feltevőjét, mert az ő összeállítása legjobb tudomásom szerint már komplett.
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 Fire/SOUL/CD #8685 üzenetére
Az 50 lap nyomtatását mindenképp ciklusba szervezném, akkor nem szükséges megfelezni a makrót.
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
Még egyszerűbben, a K oszlop sorszámozását kihagyva:
valamelyik üres oszlop első sorába =darabteli($a$1:$j$100;sor())
Ezt kell lemásolni a 100. sorig.Bár nem baj, ha nem a sorazonosítóból kell kiolvasni az értéket.
[ 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.
-
Delila_1
Topikgazda
válasz a.t.t.i. #8721 üzenetére
A megjegyzésekben történő kereséshez itt egy makró.
A makró első sorában megadott területen megvizsgálja a megjegyzések tartalmát, megkeresi bennük a megadott szöveget (keres="alma"), majd az O oszlopban egymás alatt felsorolja a találatok címét, mellettük a P oszlopban a megjegyzés teljes tartalmát.Sub Megjegyz()
Columns("O:P").Select 'Itt változtass
Selection.ClearContents
Set ter = Range("A1:C10") 'itt változtass
keres = InputBox("Mit keresel?") 'itt változtass
sor = 1
For Each CV In ter
Set kom = Range(CV.Address).Comment 'aktuális cellához csatolt megjegyzés
If Not kom Is Nothing Then 'ha van megjegyzés
sz = kom.Text 'Megjegyzés szövege
If InStr(sz, keres) Then
Cells(sor, 15) = CV.Address 'itt változtass
Cells(sor, 16) = sz 'itt változtass
sor = sor + 1
End If
End If
Next
End Sub4 helyre írtam be, hogy "itt változtass".
A másodikhoz a saját területedet írd, a 3. és 4. az O, ill. a P oszlopot jelöli ki (15 és 16) a megjegyzés cellájának, és szövegének beírásához. Az első helyen az előző beírásokat törlöm az O:P oszlopokban, vagyis csak akkor írd át, ha a 15 és 16 értéket módosítottad.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
Sub hianyzok()
Dim talal As Variant, usor As Integer, sor As Integer, sor_r As Integer
Dim nev As Variant, adat As Variant
Windows("ex2.xls").Activate
Sheets(1).Select
usor = ActiveSheet.UsedRange.Rows.Count
sor_r = 1
For sor = 1 To usor
nev = Cells(sor, 2): adat = Cells(sor, 1)
Windows("ex1.xls").Activate
Sheets(1).Select
With Columns("B:B")
Set talal = .Find(nev, LookIn:=xlValues)
If talal Is Nothing Then
Workbooks("result.xls").Sheets(1).Cells(sor_r, 1) = adat
Workbooks("result.xls").Sheets(1).Cells(sor_r, 2) = nev
sor_r = sor_r + 1
End If
End With
Windows("ex2.xls").Activate
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.
-
Delila_1
Topikgazda
Az első oszlopot sorszámnak néztem.
Sub Lel()
Dim talal As Variant, usor As Integer, sor As Integer, sor_r As Integer
Dim nev, adat1, adat2
Windows("ex2.xls").Activate
Sheets(1).Select
usor = ActiveSheet.UsedRange.Rows.Count
sor_r = 1
For sor = 1 To usor
nev = Cells(sor, 2): adat1 = Cells(sor, 1): adat2 = Cells(sor, 3)
Windows("ex1.xls").Activate
Sheets(1).Select
With Columns("B:B")
Set talal = .Find(nev, LookIn:=xlValues)
If talal Is Nothing Then
Workbooks("result.xls").Sheets(1).Cells(sor_r, 1) = adat1
Workbooks("result.xls").Sheets(1).Cells(sor_r, 2) = nev
Workbooks("result.xls").Sheets(1).Cells(sor_r, 3) = adat2
sor_r = sor_r + 1
End If
End With
Windows("ex2.xls").Activate
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.
-
Delila_1
Topikgazda
Az If talal Is Nothing Then után lévő 3 sor helyett ezt írd be:
Workbooks("ex2.xls").Sheets(1).Rows(sor).Copy Workbooks("result.xls").Sheets(1).Rows(sor_r)
Remélem, ez 1 sorban látszik, a Copy után egy szóközzel következik a Workbooks.
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
Miért akarod makróval formázni a result.xls-t? Csináld meg gyalog, sokkal gyorsabb.
Ha fejléc is lesz benne, akkor a sor_r=1 helyett sor_r=2 kell, vagy ha a címek 2 sort foglalnak le, sor_r=3. A 3 sor helyett beírt 1 sor néhány változót is fölöslegessé tett, inkább megint beteszem a lecsökkent forráskódot újra.
Sub Lel()
Dim talal As Variant, usor As Integer, sor As Integer, sor_r As Integer
Dim nev
Windows("ex2.xls").Activate
Sheets(1).Select
usor = ActiveSheet.UsedRange.Rows.Count
sor_r = 2
For sor = 1 To usor
nev = Cells(sor, 2)
Windows("ex1.xls").Activate
Sheets(1).Select
With Columns("B:B")
Set talal = .Find(nev, LookIn:=xlValues)
If talal Is Nothing Then
Workbooks("ex2.xls").Sheets(1).Rows(sor).Copy Workbooks("result.xls").Sheets(1).Rows(sor_r)
sor_r = sor_r + 1
End If
End With
Windows("ex2.xls").Activate
Next
End SubHa az ex1.xls és az ex2.xls is tartalmaz címsort, a For sor=1 To usor is For sor=2 To usor-ra változik.
Az elmúlt héten (vagy előtte) többen több helyet ajánlottunk a VB megismeréséhez, lapozz kicsit vissza.
[ 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.
-
Delila_1
Topikgazda
-
Delila_1
Topikgazda
Nagy itt a csend, írok egy feladatot.
Az egyik iskolában szorobánnal tanulnak számolni a nebulók. Itt látható a leírása.
Meg kell oldani az otthoni gyakorlást, mégpedig Excelben.A lurkó beírja a számot az E1-be, bejelöli az A5:J11 tartományban a görgők helyét. Az alsó táblázatban (A15:J21) kell megjelennie a helyes kirakás képének.
Csakis függvényekkel történhet az alsó tábla kirakása, makróval esetleg ennek az elrejtése, felfedése.A felső tábla kitöltését ne nézzétek, nem érvényes.
Csak este érek rá megnézni a nagy halom megfejtést.
[ 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.
-
Delila_1
Topikgazda
Itt egy másik megoldás, nem én követtem el, csak átvettem. A laphoz kell rendelni (lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutottál a VB szerkesztőbe, a jobb oldalon kapott üres lapra kell bemásolni. A cellára lépve megkapod a "célkereszt"-et.
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 SubProgramozó: 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
- Casco és kötelező gépjármű felelősségbiztosítás
- Android alkalmazások - szoftver kibeszélő topik
- Gaming notebook topik
- Synology NAS
- Autós topik
- Kormányok / autós szimulátorok topicja
- Távol-keleti webshopok OFF topikja (játékok, kuponok, stb.)
- 24 Hours of Le Mans
- Helldivers 2 (PC, PS5)
- Samsung Galaxy Felhasználók OFF topicja
- További aktív témák...
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Eladó Steam kulcsok kedvező áron!
- AKCIÓ! - STEAM kulcsok / Punch Club, Oddworld: Soulstorm, Children of Morta, stb. - 2024.05.16.
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs