[Delila]

elbandita

Szívesen.
Egy Access-es fórumon tedd fel a kérdést.

[elbandita]

Idézet: Delila - Dátum: 2012. 10. 23. 23:04

elbandita

Szívesen.
Egy Access-es fórumon tedd fel a kérdést.

még kérdeznék ha nem baj és hogy tanuljak is.

Hogy ha ez megvan, létrejött a 3. táblázat a keresett adatokkal, és ebből még szeretnék törölni sorokat akkor az hogy lehetséges.
pl.: az 5 oszlopban ha van érték akkor töröli az egész sort, úgy hogy ne maradjon üres, tehát felfelé csúsztatja a maradék sorokat.

Illetve ha megtennéd hogy azt elmondod hogy ezek mit csinálnak:
"usor% = Cells(Rows.Count, "A").End(xlUp).Row"

"For sor% = 2 To usor%"

nagyon köszönöm előre is, rengeteget segítettél és már most sokat tanultam.

[elbandita]

Igy sikerült megoldanom...

Sub Szortiroz()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim sor%, usor%, sorM%, Ido As Date
Set WS1 = Workbooks("forgalmi.xlsm").Sheets("Munka1") '***
Set WS2 = Workbooks("adatlap.xlsx").Sheets("Munka1") '***
Set WS3 = Workbooks("kulonbseg.xlsx").Sheets("Munka1") '***
Ido = CDate("2012.10.01") '***
sorM% = 2
WS1.Activate
usor% = Cells(Rows.Count, "A").End(xlUp).Row
For sor% = 2 To usor%
If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 Then
Rows(sor%).Copy WS3.Range("A" & sorM%)
sorM% = sorM% + 1
End If
Next
WS2.Activate
usor% = Cells(Rows.Count, "A").End(xlUp).Row
For sor% = 2 To usor%
If Cells(sor%, 5) < Ido Then
Rows(sor%).Copy WS3.Range("A" & sorM%)
sorM% = sorM% + 1
End If
Next
WS3.Activate
For sor = 2 To Range("A65536").End(xlUp).Row
Cells(sor, 6).Select
If Selection.Value <> 0 Then Selection.EntireRow.Delete
Next

End Sub

[Delila]

elbandita

Az usor% = Cells(Rows.Count, "A").End(xlUp).Row az A oszlop utolsó, értéket tartalmazó sorának a számát adja. Annak a műveletnek a VBA-s leírása, mikor az A oszlop legalsó során állsz, majd nyomsz egy Ctrl+fel nyilat.

A For sor% = 2 To usor% a 2. sortól halad az előbb megállapított sorig.

Az idézett

For sor = 2 To Range("A65536").End(xlUp).Row
   Cells(sor, 6).Select
   If Selection.Value <> 0 Then Selection.EntireRow.Delete
Next

cikluson egy keveset változtatnék, ami nagyban gyorsítja a makró futását.

usor% = Cells(Rows.Count, "A").End(xlUp).Row
For sor% = usor% To 2 Step -1
    If Cells(sor%, 6) <> 0 Then Rows(sor).Delete
Next

Sorok törlésekor érdemes az oszlop aljától felfelé haladni. Különböző adatokat tartalmazó oszlopnál észreveheted, hogy ellenkező esetben egyes sorok kimaradhatnak a meghatározott műveletből. Ebbe most nem megyek bele, hogy miért, a For-Next ciklus működését kell hozzá ismerni. Nem ördöngösség.

A Select utasítást kerüld el, ha lehet. Nem szükséges a cellára állni ahhoz, hogy a sorát töröljük. A "ráállások" növelik a futás idejét, ami nagyobb tartományon végzett műveleteknél nagy időveszteséget okoz.

Az utolsó sor meghatározására jó a Range("A65536").End(xlUp).Row a 2003-as verzióban, ahol 65536 sor van. Én az általánosabb formát részesítem előnyben, mert az bármelyik verzió alsó sorától számol.

Érdemes előre bevinni ezt az értéket egy változóba (usor=...), mert ha a For sorban adod meg, a ciklus minden tagján ki kell számolnia a gépnek ezt az értéket, ami szintén időveszteséggel jár.

[Delila]

elbandita

A két ciklusnál, amik az első és második füzetből szedik össze az adatokat, kibővítheted a feltételeket, és akkor megspórolhatod a 3. For-Next ciklust.
Azzal is időt takaríthatsz meg, ha egy-egy ciklusba "bezsúfolsz" mindent, amit lehet. Nem kell többször végigmenni a tartományokon.

Sub Szortiroz()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim sor%, usor%, sorM%, Ido As Date
    Set WS1 = Workbooks("1.xls").Sheets("Munka1")   '***
    Set WS2 = Workbooks("2.xls").Sheets("Munka1")   '***
    Set WS3 = Workbooks("3.xls").Sheets("Munka1")   '***
    Ido = CDate("2010.06.14")   '***
    sorM% = 2
    WS1.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 _
            And Cells(sor%, 6) <> 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
    WS2.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Cells(sor%, 5) = Ido And Cells(sor%, 6) <> 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
End Sub

[PoHoS]

Sziasztok,

adott egy munkalap amiből másolatot szeretnék készíteni. Másoláskor kiír egy üzenetet, miszerint egy bizonyos tartománynév már szerepel a lapon és ezt akarom-e használni a másolaton.
Névkezelőben hiába keresem, de nincs olyan nevű tartományom. Van valami módszer megtudni/kitörölni ezt az általam nem ismert elnevezést?

Köszönöm

[csozsi]

Idézet: Delila - Dátum: 2012. 10. 23. 07:55

Valamit rosszul csináltál, ha 1 cella háttérszínének a módosítása az összes többiét magával vonja. Csak rá kell állnod a színezendőre, katt a megfelelő ikonra, és kész.

Ilyet egy szóval nem mondtam. Csak annyit, hogy 2003-ban a cellakitöltés/betűszín gombból többet is fel tudok rakni a menüsorra, ami jó dolog, ellenben rossz, hogy mindegyik azonos színre áll, ha egyet is átállítanék közülük.
Megoldásként maradt 2007-ben a "cellastílusok" gyorsmenübe húzása, és így bárhol áll a menüszalag, az kéznél van, és egy lehelletnyivel gyorsabb a cellakitöltésnél.
Mindenesetre köszönöm a fáradozásodat.

[Delila]

csozsi

Az egyik ikonhoz a PirosHáttér-, a másikhoz a ZöldHáttér makrót rendeld a 2003-as verzióban. Akkor nem lesz kavarodás.

[Györgyi.]

Sziasztok!

A következőhöz kérném a segítségeteket: van egy táblázat, amelyben az egyik oszlopban dátumok vannak. Azt szeretnénk, hogy a dátumcellák az adott dátum előtt mondjuk 10 nappal figyelmeztetésként pl. sárgára színeződjenek és amikor elérjük az adott dátumot, pirosra. Brainstormingolva arra jutottunk, hogy ezt makróval tudnánk megoldani, de ahhoz egyikünk sem ért. Köszönöm.

[Delila]

Györgyi

Feltételes formázással oldhatjátok meg. Két képlet kell hozzá.
Vegyük, hogy a dátumok az A oszlopban vannak, A2-től kezdődően.

Kijelölöd A2-től kezdve a végéig a tartományt, és első feltételként ezt adod meg:
=ÉS(A2>=MA()-10;A2<MA())
Ehhez adod a sárga színt.

Marad a kijelölés, a második feltétel:
=A2=MA()
Ez lesz piros hátterű.

A képletek első egyenlőségjelét úgy kell értelmezni, mintha azt írtad volna, hogy HA. A tételek bővülésekor egyszerűen az új dátumokra másolod a formát a formátumfestő ecset segítségével.

[csozsi]

Még egy agymenés:  excelkereszt.jpg (15,13K)
Letöltések:: 12
(azaz, az adott cellára kattintásnál nem csak a "C" oszlop és "8" sor jelölője vált színt, hanem a teljes oszlop, és sor kijelölődne)
Van lehetőség ennek megvalósítására?

[Delila]

csozsi

Sub Piros()
    Rows(Selection.Row).Interior.ColorIndex = 3
    Columns(Selection.Column).Interior.ColorIndex = 3
End Sub

Ezt vissza tudod állítani kitöltés nélkülire, ha a metszéspontban indítod a Vissza makrót.

Sub Vissza()
    Rows(Selection.Row).Interior.ColorIndex = -4142
    Columns(Selection.Column).Interior.ColorIndex = -4142
End Sub

[csozsi]

Idézet: Delila - Dátum: 2012. 10. 28. 14:38

Ezt vissza tudod állítani kitöltés nélkülire, ha a metszéspontban indítod a Vissza makrót.

Biztos félreérthető voltam, mivel egy üres táblázat képét variáltam.
Nem kell színezni, egyszerűen csak a többszáz adattal teli cella közül a metszéspont oszlopai, és sorai kellene hogy kijelölődjön, egyszerre, mint ahogy az oszlopok, vagy sorok betűjére/számára kattintva kijelölődik az oszlop, vagy a sor.
Célkeresztként, hogy mindkét irányban tévedhetetlenül legyen kiolvasva az adat. Átszínezni a cellatartalmat itt már tilos, mert jelentéssel bír.

[Delila]

csozsi

A lenti makrót sajnos nem én írtam, de pontosan azt teszi, amit szeretnél.
A laphoz kell rendelned – lapfülön jobb klikk, Kód megjelenítése | bejutottál a VB szerkesztőbe, a jobb oldalon kapott üres lapra másold be.

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

[csozsi]

Idézet: Delila - Dátum: 2012. 10. 28. 16:38

csozsi

A lenti makrót sajnos nem én írtam, de pontosan azt teszi, amit szeretnél.
A laphoz kell rendelned – lapfülön jobb klikk, Kód megjelenítése | bejutottál a VB szerkesztőbe, a jobb oldalon kapott üres lapra másold be.

Ez király. De ezek szerint minden beérkezett táblázatomhoz hozzá kell rendelnem, majd eltávolítani, mielőtt visszaadom.

[Delila]

csozsi

Hozzá kell rendelni, de miért kell eltávolítani?

[hotel]

Sziasztok!

Egy kis segítséget szeretnék kérni, mert sajnos nem boldogulok egy egyszerű képlettel. Azt szeretném megoldani valahogy hogy az F4 mezőben egy függvény a következőt csinálja magától:
Ha beírok a K4-es mezőbe egy összeget akkor vizsgálja meg, hogy 150.000 Ft alatt van-e. Ha igen akkor az F4-ben jelenítse meg hogy "1000" ha 150.000Ft felett akkor pedig "2000". Eddig el is jutottam, hogy ezek kiírja de akkor is kiírja, hogy 1000 ha nincs beírva a K4-be semmi. Akkor nem szeretném hogy kiírjon valamit ha üres a K4-es mező.

Előre s köszönöm szépen a segítséget.

[PoHoS]

Idézet: hotel - Dátum: 2013. 01. 21. 22:49

Sziasztok!

Egy kis segítséget szeretnék kérni, mert sajnos nem boldogulok egy egyszerű képlettel. Azt szeretném megoldani valahogy hogy az F4 mezőben egy függvény a következőt csinálja magától:
Ha beírok a K4-es mezőbe egy összeget akkor vizsgálja meg, hogy 150.000 Ft alatt van-e. Ha igen akkor az F4-ben jelenítse meg hogy "1000" ha 150.000Ft felett akkor pedig "2000". Eddig el is jutottam, hogy ezek kiírja de akkor is kiírja, hogy 1000 ha nincs beírva a K4-be semmi. Akkor nem szeretném hogy kiírjon valamit ha üres a K4-es mező.

Előre s köszönöm szépen a segítséget.

F4 cellába ezt a képletet írd be:
=HA(K4="";"";HA(K4<=150000;"1000";"2000"))

Lehet van elegánsabb megoldás de ez is működik.

[hotel]

Idézet: PoHoS - Dátum: 2013. 01. 21. 23:23

F4 cellába ezt a képletet írd be:
=HA(K4="";"";HA(K4<=150000;"1000";"2000"))

Lehet van elegánsabb megoldás de ez is működik.

Szia!

Köszönöm a segítséget. Bemásoltam de nekem azt írja, hogy #Name. Tudod, hogy mi lehet a probléma?

Köszönöm.

[PoHoS]

Idézet: hotel - Dátum: 2013. 01. 21. 23:28

Szia!

Köszönöm a segítséget. Bemásoltam de nekem azt írja, hogy #Name. Tudod, hogy mi lehet a probléma?

Köszönöm.

Magyar vagy angol nyelvű az excel? Amennyiben angol, akkor HA csere IF-re.