Első üres sor keresése határok között makróval
2013-01-22T14:54:54+01:00
2013-01-24T18:51:40+01:00
2022-07-23T16:31:24+02:00
  • Szívesen.

    Sehogy, ez már a Társalgó állás rovata.
    Megunta a moderátor, hogy nagyon nem boldogulsz, így átrakta ide.

    Majd küld a söröket.


    Mutasd a teljes hozzászólást!
  • Hogyan tudom neked adni a pontokat a helyes megoldásért?

    Csak én nem látom??
    Mutasd a teljes hozzászólást!
  • Köszönöm, sikerült megoldani, így már rájöttem a hibára.

    köszi
    Mutasd a teljes hozzászólást!
  • Tessék.
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Mellékeltem a képet a hibáról.

    Esetleg feltöltenéd nekem az excel tábládat, hátha valamit rossz helyre másoltam.


    köszi
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Nem tudom, nálam nem ír, sem az otthoni gépemen, sem a munkahelyin.
    Egyébként milyen hibát ír?
    Mutasd a teljes hozzászólást!

  • Szia!

    Ugye ez az eredeti kód.




    Option Explicit

    Private Sub CommandButton1_Click()
    Dim forras As Worksheet, cel As Worksheet
    Dim sor As Long
    Dim darab
    If ListBox1.ListCount = 0 Then
    MsgBox "Nincs kiválasztva áru!", vbCritical
    Exit Sub
    End If
    darab = InputBox("Kérem a darabszámot", ListBox1.Value, 0)
    If Not IsNumeric(darab) Then
    MsgBox "Hibás darabszám!", vbCritical
    Exit Sub
    Else
    darab = CInt(darab)
    End If
    Set forras = Worksheets("Szerelvény Adatok")
    Set cel = Worksheets("Munka1")


    Ha innentől-----



    With cel
    sor = SorMax(.Range("a:a")) + 1

    .Cells(sor, 2).Value = ListBox1.Value
    .Cells(sor, 3).Value = darab
    .Cells(sor, 4).NumberFormat = "#,##0 $"
    .Cells(sor, 4).Value = _
    Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 3, False)
    .Cells(sor, 1).Value = _
    Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 2, False)
    End With


    -----idáig beillesztem a te kódrészletedet, akkor nekem
    hibát ír ki



    End Sub

    Private Sub ListBox1_Click()

    End Sub



    Private Sub TextBox1_Change()
    Dim munkalap As Worksheet
    Dim tartomany As Range
    Dim keres, elsotalalat
    ListBox1.Clear
    Set munkalap = Worksheets("Szerelvény Adatok")
    Set tartomany = munkalap.Range("a1:a" & SorMax(munkalap.Range("a:a")))
    With tartomany
    Set keres = .Find(What:=TextBox1.Text, Lookat:=xlPart)
    If Not keres Is Nothing Then
    elsotalalat = keres.Address
    Do
    Set keres = .FindNext(keres)
    ListBox1.AddItem munkalap.Cells(keres.Row, 1)
    Loop While Not keres Is Nothing And keres.Address <> elsotalalat
    End If
    End With



    End Sub
    Mutasd a teljes hozzászólást!
  • Egy kis módosítás, ha a sargakezdet-et a 10-es sornak veszem, ahol a felső fejléc van, akkor nem is kell a SorMax módosítása sem, elég csak ennyi változtatás:


    With cel Dim sargakezdet As Integer Dim sargaveg As Integer sargakezdet = 10 sargaveg = SorMax(.Range("a:d")) - 1 sor = SorMax(.Range("a" & sargakezdet & ":d" & sargaveg)) + 1 If Not sor < sargaveg Then .Range(.Cells(sargaveg, 1), .Cells(sargaveg, 4)).Copy .Cells(sargaveg + 1, 1).Insert Shift:=xlDown Application.CutCopyMode = False End If .Cells(sor, 2).Value = ListBox1.Value .Cells(sor, 3).Value = darab .Cells(sor, 4).NumberFormat = "#,##0 $" .Cells(sor, 4).Value = _ Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 3, False) .Cells(sor, 1).Value = _ Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 2, False) End With
    Mutasd a teljes hozzászólást!
  • Egy picit javítottam a kódon.
    Probléma volt, mint már írtam, hogy az első üres sort hol kereste.
    Most már csak a sárga tartományt nézi.
    Ha elfogyna a sárga tartomány, akkor beszúr egy újabb sort, az utolsó sor másolásával.
    Gond volt, hogy csak az A oszlopot nézte a SorMax-hoz, nálad meg van olyan, ahol nincs Cikkszám, azaz az A oszlopban nincs adat, így a SorMax nem azt adja vissza amire vártunk, ezért helyette az A:D oszlopok által határolt tartományt nézi most.

    With cel Dim sargakezdet As Integer Dim sargaveg As Integer sargakezdet = 11 sargaveg = SorMax(.Range("a:d")) - 1 If SorMax(.Range("a" & sargakezdet & ":d" & sargaveg)) = 0 Then sor = 11 Else sor = SorMax(.Range("a" & sargakezdet & ":d" & sargaveg)) + 1 End If If Not sor < sargaveg Then .Range(.Cells(sargaveg, 1), .Cells(sargaveg, 4)).Copy .Cells(sargaveg + 1, 1).Insert Shift:=xlDown Application.CutCopyMode = False End If .Cells(sor, 2).Value = ListBox1.Value .Cells(sor, 3).Value = darab .Cells(sor, 4).NumberFormat = "#,##0 $" .Cells(sor, 4).Value = _ Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 3, False) .Cells(sor, 1).Value = _ Application.VLookup(.Cells(sor, 2).Value, forras.Range("a1:c" & SorMax(forras.Range("a:a"))), 2, False) End With



    Módosítani kellett a SorMax függvényt is, mert probléma, ha nincs semmi a keresendő tartományban, ha a sárga terület teljesen üres.


    Function SorMax(celtartomany As Range) As Long Dim talal Set talal = celtartomany.Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious) If Not talal Is Nothing Then SorMax = talal.Row Else SorMax = 0 End If End Function
    Mutasd a teljes hozzászólást!
  • Szia!

    A mellékelt excel file-ban benne van a kód is.
    Ott megtudod nézni.

    Köszi
    Mutasd a teljes hozzászólást!
  • Én inkább az 1,1-et ajánlom.
    ws.Range("sárgával jelölt terület 1. oszlopának koordinátái, pl A1:A5").SpecialCells(xlCellTypeBlanks).cells(1,1)
    Mutasd a teljes hozzászólást!
  • Nem szokásom copy-paste megoldást adni, próbálkozz, tesztelj. Ha hibaüzenet van, akkor meg másold be a pontos hibaüzenetet meg a releváns kódot, ne nekünk kelljen találgatni, hogy mi lehet a gond egy olyan kóddal, amit nem is láttunk!
    Mutasd a teljes hozzászólást!
  • Köszi a hozzászólást, csak nem tudom, hogy az általad írt kódrészletet, hova, vagy mi helyett kéne beírni az én makrómba.

    Sajna nem vágom annyira a VB-t.

    Tudnál egy picit szájbarágósabban segíteni?

    köszi
    Mutasd a teljes hozzászólást!
  • Szia!

    Átírtam a sormax -okat a:a -ról a11:a26-ra, de hibaüzenetet ír, és nem működik.
    Megtudnád mondani, hogy pontosan hogy írjam át a kódot, hogy működjön?

    köszi
    Mutasd a teljes hozzászólást!
  • Azért teszi rossz helyre (persze helyesen), mert a 27. sorban is van fejléc (cikkszám, megnevezés stb.)
    Így az első üres sor a 28. lesz.

    Amikor használod a SorMaxot, akkor ne az A:A tartományt add át neki, hanem az A10:A26 -ot, ha mindig csak a sárgában szeretnél írni.

    Persze ha megtelik a sárga, akkor gond lesz... lehet nem árt figyelni és újabb üres sorokat beszúratni akkor a programmal, ami szintén sárga sor lesz majd és a lenti fejléc is lejjebb tolódik.
    Mutasd a teljes hozzászólást!



  • dim c as range ws.Range("sárgával jelölt terület 1. oszlopának koordinátái, pl A1:A5").SpecialCells(xlCellTypeBlanks).cells(0,0)

    -> ez visszaadja az 1. ilyen cellát, ha van ilyen, ennek row tulajdonsága megadja a sort. Ha nincs ilyen, akkor hibaüzenetet kapsz, amit le lehet kezelni, vagy pedig előbb egy range típusú változónak értéket adsz ws.Range("sárgával jelölt terület 1. oszlopának koordinátái, pl A1:A5").SpecialCells(xlCellTypeBlanks)-vel és megnézed,hogy a kérdéses változó nothing-e.
    Mutasd a teljes hozzászólást!
  • Sziasztok!

    olyan kérdésem lenne, hogy a mellékelt excel fileban,
    hogyan lehet azt megoldani, hogy az első üres sort úgy keresse meg, hogy megadott kettő sor között keresse.
    Mert jelen pillanatban keresi az első üres sort, de ha munkafüzetben beírok valamit a sokadik sorba, akkor a következő kiválasztást az után fogja tenni.
    de én úgy szeretném, hogy csak a sárga mezők között illessze be a kiválasztott cikket.

    Segítene valaki abban, hogy hogy írjam át a makrót?

    előre is köszi
    Mutasd a teljes hozzászólást!
    Csatolt állomány
abcd