-
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
-
Delila_1
veterán
válasz
Polllen
#27642
üzenetére
Az kell bele, mert több azonos szállítólevél is lehet. Ha ezeknek új lapot próbálnék bevinni, egyrészt hibára futna, másrészt minden sort külön lapra tenne.
A lapokat egy új kigyűjtés előtt egy makróval törölheted.
Sub Laptorles()
Dim lap As Integer
Application.DisplayAlerts = False
For lap = Sheets.Count To 2 Step -1
Sheets(lap).Delete
Next
Application.DisplayAlerts = True
End Sub -
Delila_1
veterán
válasz
Polllen
#27637
üzenetére
Nem túl bonyolult.
A makró elején töröltethettem volna az első lapon kívül a többit, hogy "tiszta lappal" kezdjünk, de nem ismerem a füzeted felépítését. Lehet, hogy vannak benne nem törölhető lapok.A makró az első lap sorain megy végig. Mikor a sorban lévő szállítólevél nevével egyező lap van a füzetben, az első üres sorába bemásolja az aktuális sort. Ha nincs olyan lap, akkor a füzet végén létrehozza, átmásolja a címsort az első lapról, majd alá az aktuális sort.
Sub Szall_Lev()
Dim sor As Long, usor As Long, usorIde As Long, nev
Dim WS As Worksheet, WSIde As Worksheet
Application.ScreenUpdating = False
Set WS = Sheets(1)
WS.Select
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
On Error Resume Next
Set nev = Sheets(Cells(sor, "A") & "")
If Err.Number <> 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = WS.Cells(sor, "A")
WS.Rows(1).Copy ActiveSheet.Range("A1")
WS.Select
End If
On Error GoTo 0
Set WSIde = Sheets(WS.Cells(sor, "A") & "")
usorIde = WSIde.Range("A" & Rows.Count).End(xlUp).Row + 1
Rows(sor).Copy WSIde.Range("A" & usorIde)
Next
Sheets(1).Activate
Application.ScreenUpdating = True
MsgBox "Kész", vbInformation
End Sub -
-
Delila_1
veterán
válasz
RedHarlow
#27630
üzenetére
Így már rendben.
A füzetben az első lap az, amin ömlesztve vannak az adatok. Ezt követi a két lap, ahova másolni kell.
A makróban két helyen szerepel a
Sheets(Array("Munka2", "Munka3")).Select
sor, ezekben írd át a Munka2 és Munka3 lapneveket a füzetedben lévő 2. és 3. lap nevére.Szerk.: persze az X1–X4 és Y1–Y6 adatokat is írd át!
Sub SzetCincal()
Dim nev As String, sor As Long, usor As Long, usorIde As Long
Dim WS As Worksheet, WSIde As Worksheet, lap As Integer
Set WS = Sheets(1)
'Előző adatok törlése
Sheets(Array("Munka2", "Munka3")).Select
Cells.Select
Selection.ClearContents
'Címsor a 2 lapra
WS.Rows("1:1").Copy
Sheets(Array("Munka2", "Munka3")).Select
Range("A1").PasteSpecial xlPasteValues
'Szortírozás
WS.Select
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
nev = Cells(sor, 6)
Select Case nev
Case ""
If Cells(sor, 5) = "Y1" Or Cells(sor, 5) = "Y2" Or _
Cells(sor, 5) = "Y3" Then lap = 2
If Cells(sor, 5) = "Y4" Or Cells(sor, 5) = "Y5" Or _
Cells(sor, 5) = "Y6" Then lap = 3
Case "X1", "X2"
lap = 2
Case "X3", "X4"
lap = 3
Case Else
GoTo Tovabb
End Select
Set WSIde = Sheets(lap)
usorIde = WSIde.Range("A" & Rows.Count).End(xlUp).Row + 1
Rows(sor).Copy WSIde.Range("A" & usorIde)
Tovabb:
Next
End Sub -
Delila_1
veterán
válasz
RedHarlow
#27628
üzenetére
Így már kicsit több az információ, de még nem derült ki, mi a feladat.
Most próbáld meg úgy leírni, ahogy az Excel szereti.Példa: ha az A oszlopban X1, X2, X3, vagy X4 van az aktuális sorban, akkor a sort másolni kell a .... lapra.
Ha az A értéke X5, vagy X6, akkor ..., ha az A értéke X7, akkor ...Ha az A üres, és a B tartalma Y1, Y2, vagy Y3, akkor...
Ha az A üres, és a B tartalma Y4, Y5, vagy Y6, akkor... -
Delila_1
veterán
válasz
RedHarlow
#27625
üzenetére
Kicsit több adatra van szükség.
7 ügyintéződ van? Melyik oszlopban van a nevük?
A lapok neve megegyezik az ügyintézőjével (kivéve az első lapot, ahol az összes adat van ömlesztve)?
Ha nincs ügyintéző, akkor az első ügyintéző lapjára kerüljenek az adatok a B oszlop tartalmától függően?
Ha nem X, D, vagy K a B oszlop tartalma, hova kerüljön a sor?Egyébként ha 1× kell szétosztani az adatokat, néhány autoszűréssel, a szűrt adatok másolásával egyszerűen megoldható.
-
#27610
Delila_1
veterán
sutyimatyi
#27609
Delila_1
veterán
válasz
sutyimatyi
#27609
üzenetére
Egy oszlopba felveszed az év ünnepnapjainak a dátumát, a tartományt elnevezed. Legyen a neve pl. Ünnepek.
A feltételes formázás képlete
=DARABTELI(Ünnepek; Dátumot_tartalmazó_cella)>0A hétvégéket is bele véve a képlet
=VAGY(HÉT.NAPJA(Dátumot_tartalmazó_cella;2)>5;DARABTELI(Ünnepek;Dátumot_tartalmazó_cella)>0) -
Delila_1
veterán
válasz
Carasc0
#27604
üzenetére
Csak írd be az A oszlopba az adatokat. Ha nem kerek számot adna az adatok darabszámának a gyöke, hibajelzést kapsz.
Hibátlan darabszámnál kiírja a "kevert" mátrixot a D1 cellától kezdődően. 9; 16; 25; és 36 adatra kipróbáltam, nem kell módosítanod semmit. Illetve ha nem tetszik, hogy D1-be kezd írni, akkor a
sor = 1: oszlop = 4 sorban a 4-et írd át a kedvenc oszlopod sorszámára.Sub Kever()
Dim usor As Integer, gyok As Integer, CV As Range
Dim sor As Integer, oszlop As Integer
Application.ScreenUpdating = False
usor = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo Vege
gyok = Application.WorksheetFunction.ImSqrt(usor)
Range("A1:A" & usor).Copy Range("B1")
Range("C1:C" & usor) = "=rand()"
Range("C1:C" & usor).Copy
Range("C1").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Add Key:=Range("C1:C" & usor), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Munka1").Sort
.SetRange Range("B1:C" & usor)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
sor = 1: oszlop = 4
For Each CV In Range("B1:B" & usor)
If sor > gyok Then
sor = 1
oszlop = oszlop + 1
End If
CV.Copy Cells(sor, oszlop)
sor = sor + 1
Next
Range("B1:C" & usor).ClearContents
Range("D1").Select
Application.ScreenUpdating = True
Exit Sub
Vege:
MsgBox "Nem adnak mátrixot az adatok", vbInformation
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
Carasc0
#27601
üzenetére
A makró átmásolja az A1:A9 tartományt a B1:B9-be. Véletlenszámokat ír a C1:C9-be, ami szerint rendezi a B oszlopot, majd törli az ideiglenes C-t.
A rendezést makrórögzítéssel vittem be.Sub Kever()
Dim sor As Integer
Range("A1:A9").Copy Range("B1")
For sor = 1 To 9
Cells(sor, "C") = "=RAND()"
Cells(sor, "C") = Cells(sor, "C").Value
Next
ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Add Key:=Range("C1:C9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Munka1").Sort
.SetRange Range("B1:C9")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C1:C9").ClearContents
End SubBetehetsz egy képernyőfrissítés tiltását az elejére, hogy ne látsszanak a véletlenek, a végén pedig engedélyezed.
Application.ScreenUpdating=False
-
#27549
Delila_1
veterán
ElemiKoczka
#27547
Delila_1
veterán
válasz
ElemiKoczka
#27547
üzenetére
A 27332-es kérdést, és a rá adott, 23333-as választ olvasd el. Az első lapra beteszel egy érvényesítést, amivel kiválasztod a receptet. A makró az első lap H1 cellájából veszi a keresendő értéket, itt lehet az érvényesítésed.
Ha a kód, és a leírás azonos sorban van, ez a makró jó lesz a feladatod megoldására.
-
Delila_1
veterán
válasz
azopi74
#27533
üzenetére
Tömbképlettel:
{=HAHIBA(INDEX($A$2:$A$12;HOL.VAN(0;DARABTELI($B$1:C1;$A$2:$A$12);0));"")}
Egyszerűbben, ha tartománnyá alakítjuk az A1:B12 területet, az A2:A12-nek Lista nevet adunk:
{=HAHIBA(INDEX(Lista;HOL.VAN(0;DARABTELI(B$1:$B1;Lista);0));"")}
Ez utóbbi a lista bővülésekor automatikusan bővíti a kigyűjtést.
-
Delila_1
veterán
válasz
Zola007
#27519
üzenetére
Nem kell semmit telepíteni, vásárolni, makróval megoldhatod. A kijelölt, akár nem összefüggő területek hátterét változtatja meg a lenti két makró.
Sub PirosHatter()
Selection.Interior.Color = RGB(255, 0, 0)
End SubSub ZoldHatter()
Selection.Interior.Color = RGB(0, 255, 0)
End SubA zárójelben lévő értékeket 0 és 255 között változtatva mindenféle színt, árnyalatot előállíthatsz.
Ha ezeket a makrókat a personal.xlsb-be mented, akkor bármelyik füzetedben alkalmazhatod.
Gyorsbillentyű hozzárendelése: Alt+F8-cal megjeleníted a makrókat. Kiválasztod az egyiket, és az Egyebek gomb segítségével megadod a CTRL gombhoz rendelt betűt.A színek RGB értékeit könnyen "kitalálhatod". A Kezdőlapon a háttér beállításánál a További színeket választod, az Egyéni fülön kikevered a megfelelő színt, a hozzá tartozó 3 értéket írod a makróba.
-
#27508
Delila_1
veterán
scott_free
#27507
Delila_1
veterán
válasz
scott_free
#27507
üzenetére
Szivi.
-
#27505
Delila_1
veterán
scott_free
#27501
Delila_1
veterán
válasz
scott_free
#27501
üzenetére
A helyedben a combobox feltöltését a userform aktiválásához rendelném.
Private Sub UserForm_Activate()
Dim szám
For Each szám In Sheets(1).Range("C1:C20")
If Len(szám) = 10 Then
ComboBox1.AddItem szám.Offset(0, -2).Value
End If
Next szám
End SubA len(szám)-nál hiba volt len(szám.value)-t írni, hiszen a len függvény a beolvasott adat hosszát adja, a value pedig az értékét.
-
#27500
Delila_1
veterán
scott_free
#27499
Delila_1
veterán
válasz
scott_free
#27499
üzenetére
Legegyszerűbb, a Lista1 RowSource tulajdonságánál adod meg: Munka1!A1:A10, akkor egyáltalán nem kell külön inicializálnod.
-
#27498
Delila_1
veterán
scott_free
#27496
Delila_1
veterán
válasz
scott_free
#27496
üzenetére
"lista1" nevű listbox csak 2 különböző userformon lehet. Az egyes userformok makrói hivatalból külön makrólapon vannak, ezért nem kavarodhat a rájuk történő hivatkozás.
Ha a "lista1" nem objektum, hanem változó, akkor publikussá teheted, így minden makró a pillanatnyi értékét fogja használni. A makrólap tetején Public lista1 As ... a deklaráció, a makrókban nem kell (ilyen esetben nem is szabad) külön deklarálni.
-
Delila_1
veterán
válasz
Melack
#27477
üzenetére
A próbánál a füzet utolsó lapját elneveztem Gyűjtés-nek. A MitKeres változóba tettem be a keresendő adatot.
A makró az elsőtől az utolsó előtti lapig megkeresi a MitKeres értéket, és a találat sorát a Gyűjtés lap első üres sorába bemásolja.Sub Kigyujt()
Dim lap As Integer, WSG As Worksheet, Hol, usor As Long
Application.ScreenUpdating = False
Const MitKeres = "Máté" 'Itt add meg a keresendő értéket
Set WSG = Sheets("Gyűjtés")
WSG.Rows("2:2000") = ""
For lap = 1 To Worksheets.Count - 1
Sheets(lap).Select
Set Hol = Cells.Find(MitKeres, LookIn:=xlValues, lookat:=xlWhole)
If Hol Is Nothing Then
GoTo Tovabb
Else
usor = WSG.Range("A" & Rows.Count).End(xlUp).Row + 1
Rows(Hol.Row).Copy WSG.Range("A" & usor)
End If
Tovabb:
On Error GoTo 0
Next
WSG.Select
Application.ScreenUpdating = True
End SubEz laponként az első találatot teszi ki. Ha több kell, valaki biztosan segít, most el kell mennem.
-
Delila_1
veterán
Szerintem sem jó az előre kiporciózott 3-3 tétel. Egyrészt mert előfordulhat napi több tétel kiadás, másrészt ha kevesebb a költekezés, üres sorok maradnak, ami feleslegesen növeli a táblázat méretét.
Ha nincsenek üres sorok az A oszlopban, tudsz szűrni dátum szerint. A napi (vagy heti, havi, negyedéves) összeget a szűrt táblában a RÉSZÖSSZEG (SUBTOTAL) azonnal megmutatja.
Az F2, G2 hosszú képlete helyett alkalmazhatod a SZUMHA (SUMIF) függvényt, de bőven elég az F2-ben az =SUM(D:D) is, ehhez nem szükséges azonos helyen lenniük az oszlopban az összegeknek.
Kimutatással is érdemes próbálkozni.
-
#27424
Delila_1
veterán
m.zmrzlina
#27423
Delila_1
veterán
válasz
m.zmrzlina
#27423
üzenetére
Függvénnyel nagyon egyszerű lenne. A két adat A, ill. B oszlopban van.
C-> =ha(trim(a2)=trim(b2);0;1)
D1=szum(c:c), ez megadja az eltérések számát -
#27389
Delila_1
veterán
scott_free
#27387
Delila_1
veterán
válasz
scott_free
#27387
üzenetére
Próbáld már meg magát a feladatot, a megoldástól függetlenül leírni. Ha ... ide beírok ...-t, akkor ... itt ... ez történjen.
Azt hiszem túlbonyolítod a megoldást. -
#27380
Delila_1
veterán
scott_free
#27379
Delila_1
veterán
válasz
scott_free
#27379
üzenetére
Az eseménykezelés csakis az A oszlopba írt érték változása következtében hívja meg a Beiras makrót. Ezután bármelyik pontszámot büntetlenül felülírhatod, azok más oszlopokban vannak.
-
Delila_1
veterán
válasz
sedyke
#27370
üzenetére
Szívesen, örülök, hogy végül összejött.
For lap = 2 To Sheets.Count
Sheets(lap).SelectIde kell beszúrni a kihagyandó lap sorszámát. Ha például az ötödiket akarod kihagyni (beleszámolva az elsőt is), akkor
For lap= 2 To Sheets.Count
If lap=5 Then Exit For
Sheets(lap).SelectTöbb lap kihagyásánál a feltétel sora például
If lap=3 Or lap=5 Or lap=6 Then Exit For
-
#27368
Delila_1
veterán
scott_free
#27364
Delila_1
veterán
válasz
scott_free
#27364
üzenetére
Azért nem működik, mert a laphoz rendelt makró csakis a saját lapján tud működni. Van viszont mód rá, hogy másik lapon, lapról dolgozzon, ehhez meg kell hívni egy modulban lévő másik makrót, átadva a szükséges értékeket.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
Application.EnableEvents = False
Beiras Target.Row, Target 'itt hívjuk meg a Beiras makrót, átadva az aktuális sort és a bevitt értéket
Application.EnableEvents = True
End If
End SubA Beiras makró modulban van.
Sub Beiras(sor, ertek) 'itt veszi át a két értéket, amiket felhasznál
Dim Hol As Range
Set Hol = Sheets("Nevek").Range("NevekPontok")
With Sheets(1)
Select Case ertek
Case 0
.Range("B" & sor & ":G" & sor) = 0
Case 1
.Cells(sor, "B") = Hol(1)
.Cells(sor, "C") = Hol(1).Offset(, 1)
.Cells(sor, "D") = Hol(1).Offset(1)
.Cells(sor, "E") = Hol(1).Offset(1, 1)
Case 3
.Cells(sor, "B") = Hol(1).Offset(2)
.Cells(sor, "C") = Hol(1).Offset(2, 1)
.Cells(sor, "D") = Hol(1).Offset(3)
.Cells(sor, "E") = Hol(1).Offset(3, 1)
.Cells(sor, "F") = Hol(1).Offset(4)
.Cells(sor, "G") = Hol(1).Offset(4, 1)
End Select
End With
End SubNem adtad meg, és én nem tudtam kihámozni, mi legyen kettes sorszám bevitelekor.
-
Delila_1
veterán
válasz
sedyke
#27365
üzenetére
A makró angol nyelven van, nem is lehet másképp.
A füzetedben Alt+F11-re megnyílik a VBA szerkesztője. Bal oldalon kiválasztod a füzetedet, Majd Insert menü, Module.
Beszúrtál egy új modult, ami Module1 névre hallgat. Ez van kijelölve a beszúrás után. Az ablakod jobb oldalán kapsz egy nagy üres felületet, oda másold be a makrót. Bezárhatod ezt az ablakot, és a szokásos módon (Alt+F8) futtathatod a makrót. -
-
Delila_1
veterán
válasz
sedyke
#27360
üzenetére
Azt hiszem, ne pontosan írtad le a feladatot. Megírtam a makrót a következő felállásra:
A füzet első lapja az összesítés, ahol a termékek az A oszlopban vannak. Azt az esetet vettem, hogy nincsenek üres sorok, és az első a címsor.
Az összes többi lapon keresünk.A makró megjegyzi az összesítő lap A2-es cellájának az értékét, majd sorban ellenőrzi a többi lapon, hogy van-e ilyen nevű termék. Ha valamelyiken talál, akkor az összesítő lap W2 cellájába beírja a kért szöveget.
Következik az A3-as cella vizsgálata, majd így tovább az utolsó sorig.Sub Van_e()
Dim talal, sor As Long, usor As Long, nev, lap As Integer
Dim WS As Worksheet
Set WS = Sheets(1)
usor = WS.Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
nev = WS.Cells(sor, "A")
For lap = 2 To Sheets.Count
Sheets(lap).Select
Set talal = Cells.Find(nev, LookIn:=xlValues, lookat:=xlWhole)
If talal Is Nothing Then
GoTo Tovabb
Else
WS.Cells(sor, "W") = "in user"
Exit For
End If
Tovabb:
Next
Next
End Sub -
Delila_1
veterán
válasz
sedyke
#27356
üzenetére
A leírásodból arra következtetek, hogy a keresett termék 1-1 egyszer fordul elő. Ehhez itt a makró.
Sub In_Use()
Dim lap As Integer, sor As Long
For lap = 1 To Sheets.Count
sor = Application.Match("keresett_termék", Sheets(lap).Columns(1), 0)
If Not VarType(sor) = vbError Then Sheets(lap).Cells(sor, "W") = "in use"
Next
End Sub -
Delila_1
veterán
válasz
ztoldy
#27352
üzenetére
Mi különbözteti meg ezeket a számokat a többitől? Kisebbek, vagy nagyobbak az átlagnál? Az A oszlop azonos sorában lévő adat szerint kell ezeket kihagyni az összegzésből?
A fenti, és hasonló esetekben a SZUMHA, vagy több feltételnél a SZUMHATÖBB függvényt alkalmazhatod.
-
Delila_1
veterán
Egy másik módszer:
Kijelölöd a tartományt, amiben keresni akarsz. A Képletek | Definiált nevek | Kijelölésből új funkcióval egyszerűen létrehozod a sorok és oszlopok elnevezéseit. Az E4 cellában láthatod a metszet-, vagy más néven szóköz operátort. Metszet a neve, mert a képletben lévő, 2 elnevezett tartomány metszetét adja, vagy szóköz a neve, mert a két operandust szóköz választja el.
Arra kell figyelni, hogy az automatikus elnevezés az eredeti névben esetlegesen előforduló szóközök helyett alsó kötjelet ír, tehát a Kiss Bori helyett a hivatkozási név Kiss_Bori lesz. A képletben
=Kiss_Bori Foglalkozás -t kell írni.
-
Delila_1
veterán
Nézd meg az INDEX, és a HOL.VAN függvényeket, ezekkel tudod megkeresni a táblázatban.
Lehet, hogy nem a táblázatban akarod megtalálni a C4 celládnak megfelelő értéket, csak az a célod, hogy a C4 sorát és oszlopszámát megtudd. Ebben az esetben a sort az =SOR(C4), az oszlopszámot az =OSZLOP(C4) képlet adja meg.
-
Delila_1
veterán
válasz
morgusz
#27323
üzenetére
Ez könnyen megoldható.
A lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutottál a VB szerkesztőbe. A jobb oldalon lévő nagy üres mezőbe másold be a makrót:Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Offset(, 1) = Date
Application.EnableEvents = True
End SubBezárod az ablakot a szokásos X-szel, és már töltheted is tovább a táblázatodat.
-
#27320
Delila_1
veterán
scott_free
#27319
Delila_1
veterán
válasz
scott_free
#27319
üzenetére
Különálló cellákról van szó? Ezeket kijelölve nevet adtam a tartománynak, a név "valami".
Érték beillesztése a képletek helyére az elnevezett tartományban:
Sub Ertek()
Dim CV As Range
For Each CV In Range("valami")
CV.Copy
CV.PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End SubAz elnevezett tartomány nyomtatása:
Sub Nyomtat()
Application.Goto Reference:="valami"
Selection.PrintOut Copies:=1
End SubKijelölt tartomány nyomtatása:
Sub Nyomtat()
Selection.PrintOut Copies:=1
End Sub -
Delila_1
veterán
válasz
attilalr2
#27317
üzenetére
A másodikat használd! Az elsőben szerepel az INDIREKT függvény, de csak azért, mert a saját oszlopában kellett keresni, és ennek a segítségével kilőttem a körkörös hivatkozást.
Az INDIREKT függvény mindig, mikor új adatot viszel be a lapra (vagy törölsz), frissül, ezzel lassul a számolás.
-
-
Delila_1
veterán
A lenti makrót a VB szerkesztőben a ThisWorkbook laphoz kell rendelned.
A Sheets("Munka1") helyett a saját lapodat add meg, a Range("A1") helyett pedig azt a cellát, ahova az aktuális időt akarod beíratni. Ennek a cellának a formátuma lehet például éééé.hh.nn óó:pp:mmPrivate Sub Workbook_Open()
With Sheets("Munka1")
.Range("A1") = Now
.Range("A1").Copy
.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End Sub -
Delila_1
veterán
válasz
azopi74
#27304
üzenetére
Megjegyzésbe tettem.
Előbb egy ciklusban megjegyzéseket fűztem az A oszlop celláihoz, amik az E oszlop adatait tartalmazzák. Ezt 1× kell lefuttatni. Utána eseménykezelővel az aktuális sorban végeztem el ugyanezt.
Range("A" & sor).Comment.Text Text:=Range("E" & sor).Value
-
Delila_1
veterán
válasz
róland
#27296
üzenetére
Vigyél érvényesítést a cellára, ahol a Figyelmeztető üzenet fülön a Figyelmeztetés mezőben add meg a megjelenítendő szöveget. Ez akkor jelenik meg, ha rákattintasz a cellára, de talán így is elfogadható.
Azt, hogy a "másik cella tartalma megjeleníthető legyen", a fényképezőgép ikon segítségével állíthatod elő. Keress rá a szóra itt, a topicban.
-
#27298
Delila_1
veterán
scott_free
#27297
Delila_1
veterán
válasz
scott_free
#27297
üzenetére
Nézd meg ezt az előzményeivel.
Neked az oszlopszélességet kell beállítanod az ízlésed szerint. Meglehet, hogy valamelyik gépen, ahol megfordult a fájlod, létezik egy Munkafüzet nevű sablon, elállított szélességekkel.A régi hsz a 2003-as verzióhoz, és valami régebbi Windowshoz szólt. Ha a kedved szerint formázott füzetet sablonként mented, az Excel a megfelelő kiterjesztéssel menti a megfelelő helyre, csak a neve legyen Munkafüzet, sorszám nélkül.
-
#27251
Delila_1
veterán
dellfanboy
#27250
Delila_1
veterán
válasz
dellfanboy
#27250
üzenetére
Ez a formátum jobbra igazítja az ezres csoportosítású számot, a jobb szélén 1 szóköznyi behúzással, hogy ne másszon rá csúnyán a szegélyre.
Sub EzresCsop()
Selection.NumberFormat = "#,##0 _ ;-#,##0 _ "
End SubSzóköznyi behúzás nélkül
Sub EzresCsop()
Selection.NumberFormat = "#,##0;-#,##0"
End Sub -
#27202
Delila_1
veterán
scott_free
#27201
Delila_1
veterán
válasz
scott_free
#27201
üzenetére
=szum(G:G)
-
Delila_1
veterán
"...Delila_1 topikgazdának"
Múltkor említettem, hogy a választ a Válasz gomb segítségével kellene megadnod, úgy sokkal könnyebben megtaláltam volna most az eredeti kérdésedet.
Módosítottam a makrót.
Sub HolTalalhato()
Dim sorB As Long, sorC As Long, usor As Integer, uoszlop As Integer
usor = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
sorB = 2
For sorB = 2 To usor
For sorC = 2 To usor
If Cells(sorC, 3) = Cells(sorB, 2) Then
If Cells(sorB, 4) = "" Then
Cells(sorB, 4) = Cells(sorC, 1)
Else
Cells(sorB, 4) = Cells(sorB, 4) & "–" & Cells(sorC, 1)
End If
End If
Next
Next
End Sub -
Delila_1
veterán
válasz
slashing
#27168
üzenetére
Az értékké alakítás ennyi
Sub Ertek_beillesztese()
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End SubBill. kombinációt is rendelhetsz hozzá.
Csak arra kell ügyelni, hogy az utolsó sor ne legyen kijelölve, másképp ott is felülírja a képleteket. -
Delila_1
veterán
válasz
slashing
#27166
üzenetére
Feltételezem, hogy a régebben bevitt soroknál a képleteket helyettesítheted az értékükkel (másolás, irányított beillesztés ugyanoda, értékként).
Ha a kitöltetlen sorokat kivéve táblázattá alakítod a táblázatodat (MS-ék találták ki ezt az ostoba elnevezést), akkor egy új sor a bevitelekor átveszi a fölötte lévő sor képleteit, és még a formátumokat is.
2003-as verzióig listává alakításnak nevezik a táblázattá alakítást.
-
Delila_1
veterán
válasz
Delila_1
#27164
üzenetére
Érdemes volt elmenni, visszajönni. Útközben beugrott a megoldás a 10-zel kezdődő adatokhoz.
Function Karaktercsere(Szoveg As Range) As String
Dim strTemp As String, hossz As Integer, b As Integer, sor As Long
Dim sz As String, kezd As Integer
sor = Szoveg.Row
sz = Szoveg.Value
hossz = Len(Szoveg)
If Left(sz, 2) = "10" Then
strTemp = "x.menet"
kezd = 3
Else
kezd = 1
End If
For b = kezd To hossz
If Mid(sz, b, 1) = "2" Then
strTemp = strTemp & "k.csavar"
ElseIf Mid(sz, b, 1) = "5" Then
strTemp = strTemp & "k.csavar2"
ElseIf Mid(sz, b, 1) = "7" Then
strTemp = strTemp & "l.alátét"
ElseIf Mid(sz, b, 2) = "10" Then
strTemp = Left(strTemp, Len(strTemp) - 1) & "+x.menet"
b = b + 1
Else
strTemp = strTemp & Mid(sz, b, 1)
End If
Next b
Karaktercsere = Cells(sor, "A") & "+" & strTemp
End Function -
Delila_1
veterán
válasz
azopi74
#27162
üzenetére
Javítva
Function Karaktercsere(Szoveg As Range) As String
Dim strTemp As String, hossz As Integer, b As Integer, sor As Long
Dim sz As String
sor = Szoveg.Row
sz = Szoveg.Value
hossz = Len(Szoveg)
For b = 1 To hossz
If Mid(sz, b, 1) = "2" Then
strTemp = strTemp & "k.csavar"
ElseIf Mid(sz, b, 1) = "5" Then
strTemp = strTemp & "k.csavar2"
ElseIf Mid(sz, b, 1) = "7" Then
strTemp = strTemp & "l.alátét"
ElseIf Mid(sz, b, 2) = "10" Then
strTemp = Left(strTemp, Len(strTemp) - 1) & "+x.menet"
b = b + 1
Else
strTemp = strTemp & Mid(sz, b, 1)
End If
Next b
Karaktercsere = Cells(sor, "A") & "+" & strTemp
End Function
Új hozzászólás Aktív témák
Hirdetés
- Gyermek PC játékok
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- DUPLA XEON GOLD 6134!!! HP Z8 G4 LEGNAGYOBB WORKSTATION 64GB 2x8 mag 2x16 szál gamer, szerver, munka
- Telefon felvásárlás!! Samsung Galaxy S23/Samsung Galaxy S23+/Samsung Galaxy S23 Ultra
- LG 32SQ700S-W - 32" VA Smart - 3840x2160 4K UHD - 62Hz 5ms - WebOS - Wifi + BT - USB-C - Hangszórók
- ÁRGARANCIA! Épített KomPhone i7 14700KF 32/64GB RAM RTX 5090 32GB GAMER PC termékbeszámítással
- Csere-Beszámítás! Olcsó Számítógép PC Játékra! R5 1500X / RX 570 8GB / 16GB DDR4 / 250SSD + 2TB HDD
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: CAMERA-PRO Hungary Kft
Város: Budapest