Excel VBA cikluson belül ciklus futtatása
2019-11-11T11:43:14+01:00
2019-11-15T19:35:50+01:00
2022-08-11T16:10:30+02:00
amatore
Üdv,

Segítséget szeretnék kérni egy olyan feladathoz, hogy egy excel fájlon belül az egyik sheet E és F oszlopában szereplő adatokat (soron belül a két oszlop adatai egybetartoznak) meg kell találnom a másik sheet K és F oszlopában (itt szintén az egy sorban lévő adatok összetartoznak). Az 1. sheeten szereplő két oszlop kombinációkat tartalmaz. A meg nem talált sorokat (kombinációkat) az 1. sheet-ről át kell másolni a 2. sheet adatálloányának végére, illetve akkor is át kell másolni, ha megtalálja, de a 2. sheet 12. oszlopában "Failed" érték van.
Valójában csak próbálkozok, de mindig hibára fut a félkövérrel írt parancssor.. Ha valaki meg tudná mondani, hogy hol rontom el, nagyon szuper lenne.
Előre is nagyon köszönöm.
Ezt írtam:


Sheets("Lists").Select
usor1 = Range("E1").End(xlDown).Row


Dim i As Long, j As Long
For i = 2 To usor1
If Cells(i, 5) <> 0 Then

Sheets("Main Sheet").Select
usor2 = Range("B1").End(xlDown).Row
esor2 = usor2 + 1

For j = 2 To usor2
If ActiveWorkbook.Sheets("Lists").Cells(i, 5) = ActiveSheet.Cells(j, 11) And ActiveWorkbook.Sheets("Lists").Cells(i, 6) = ActiveSheet.Cells(j, 6) And ActiveSheet.Cells(i, 12).Value = "Failed" Then
ActiveSheet.Cells(esor2, 11) = ActiveWorkbook.Sheets("Lists").Cells(i, 5).Value
ActiveSheet.Cells(esor2, 6) = ActiveWorkbook.Sheets("Lists").Cells(i, 6).Value
Sheets("Main Sheet").Select
esor2 = esor2 + 1
ElseIf ActiveWorkbook.Sheets("Lists").Cells(i, 5) <> ActiveSheet.Cells(j, 11) And ActiveWorkbook.Sheets("Lists").Cells(i, 6) <> ActiveSheet.Cells(j, 6) Then
ActiveSheet.Cells(esor2, 11) = ActiveWorkbook.Sheets("Lists").Cells(i, 5).Value And ActiveSheet.Cells(esor2, 6) = ActiveWorkbook.Sheets("Lists").Cells(i, 6).Value
Sheets("Main Sheet").Select
esor2 = esor2 + 1
End If
Next j

End If
Next i
Mutasd a teljes hozzászólást!
Szia!

Túlkombináltad.....

Sub Kiosztas() Application.ScreenUpdating = False Sheets("Műveletek").Select usor1 = Range("E1").End(xlDown).Row Dim i As Long, j As Long, flag As Boolean For i = 2 To usor1 flag = True Sheets("Munka kiosztás").Select usor2 = Range("A1").End(xlDown).Row esor2 = usor2 + 1 For j = 2 To usor2 If ActiveWorkbook.Sheets("Műveletek").Cells(i, 5) = ActiveSheet.Cells(j, 1) And ActiveWorkbook.Sheets("Műveletek").Cells(i, 6) = ActiveSheet.Cells(j, 2) And ActiveSheet.Cells(i, 3).Value <> "Elmaradt" Then flag = False: Exit For End If Next j If flag Then ActiveSheet.Cells(esor2, 1) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 5).Value ActiveSheet.Cells(esor2, 2) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 6).Value ActiveSheet.Cells(esor2, 3).Value = "Folyamatban" Sheets("Munka kioszt?s").Select End If Next i Sheets("Munka kiosztás").Activate Application.ScreenUpdating = True End Sub
Üdv.
Ps. Használd a forráskód (</>) gombot a makrókhoz légy szíves.
Mutasd a teljes hozzászólást!

  • tüzetesen nem néztem át, 
    de nem kell az AND a vastagított részben, az biztosnak látszik.
    Mutasd a teljes hozzászólást!
  • Igen, ezt is probaltam, amivel tovabb is lepett, de ezzel atugrott egy private sub worksheet_change kodra, ahol rogton megallt.
    De akkor most megerositest kaptam, hogy akkor ezzel a megoldassal jo lesz a makro, csak a worksheet kodom nem.
    Koszonom szepen
    Mutasd a teljes hozzászólást!
  • Illetve megsem jo, mert igy csak az AND elotti reszt vegzi el a makro, az AND utanit nem. Es szerintem ezert all le utana a worksheet kodom.
    Mutasd a teljes hozzászólást!
  • Elnezest, megis csak jo ez a megoldas.
    Koszonom
    Mutasd a teljes hozzászólást!
  • Hello,

    Ugyanez a probléma, egymásba ágyazott ciklus.
    De kicsit más elrendezésben, csatoltam a fájlt.
    Tehát a feladat az, hogy a Műveletek sheet E és F oszlopában szereplő kombinációkat (amik folyamatosan változnak) le kell ellenőriznem a Munka kiosztás sheet-en, hogy megtalálhatóak-e és a státusz szerint a munka Befejezett vagy Folyamatban (4 lehetőség van: Folyamatban, Befejezett, Elmaradt, ""), és ha igen, akkor nem kell odaámásolni a kombinációt. Ha viszont nem találja a kombinációt, vagy megtalálja, de a státusz: Elmaradt, akkor oda kell másolni a Munka kiosztás sheet-re.

    És sajnos nem igazán a leírtak alapján működik a makróm. Esetleg valaki meg tudná mondani, hogy mit rontottam el?
    28 kombináció van, és ebből 4 Befejezett vagy Folyamatban, azaz 24 új kombinációnak kell megjelennie a Munka kiosztás sheeten. Az eddigi kiosztott munkák sárgával szinezve. De 27 új kombinációt másol át.

    Nagyon köszönöm.
    Üdv,
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Annyit sikerült csak kiderítenem, hogy az i-ket mindig a j-k legelső eleéhez hasonlítja hozzá és nem veszi figyelembe a státuszt sem.
    Mutasd a teljes hozzászólást!
  • Szia!
    Nem jó a folyamat vezérlésed.
    Csinálj hozzá légy szíves egy folyamatábrát és az alapján írd meg a makrót.

    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia,
    Úgy tettem, a folyamatábrát mindig megcsinálom. És ennek ellenére nem jön ki az az eredmény, amit szeretnék. Pedig már több variációt is kipróbáltam a makróban.
    Ezért is kérem a segítséget.
    Köszönöm.
    Üdv,
    Mutasd a teljes hozzászólást!
  • Illetve még egyet nem próbáltam.
    Mindjárt visszajelzek.
    Mutasd a teljes hozzászólást!
  • Erre írtam át, bold-dal a módosítás, de még így is csak a j 1. rekkordjához hasonlít mindent. És már nincs több ötletem, hogy mit kellene másképp.

    Sub Kiosztas()


    Application.ScreenUpdating = False


    Sheets("Műveletek").Select
    Dim usor1 As Long
    usor1 = Range("E1").End(xlDown).Row


    Dim i As Long, j As Long
    For i = 2 To usor1

    Sheets("Munka kiosztás").Select
    Dim usor2 As Long
    usor2 = Range("A1").End(xlDown).Row
    Dim esor2 As Long
    esor2 = usor2 + 1

    For j = 2 To usor2

    If ((ActiveWorkbook.Sheets("Műveletek").Cells(i, 5) & ActiveWorkbook.Sheets("Műveletek").Cells(i, 6)) = _
    (ActiveSheet.Cells(j, 1) & ActiveSheet.Cells(j, 2))) And ActiveSheet.Cells(j, 3).Value <> "Elmaradt" Then
    Exit For
    Else
    ActiveSheet.Cells(esor2, 1) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 5).Value
    ActiveSheet.Cells(esor2, 2) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 6).Value
    ActiveSheet.Cells(esor2, 3).Value = "Folyamatban"
    Sheets("Munka kiosztás").Select
    End If

    Next j

    Next i


    Sheets("Munka kiosztás").Activate


    Application.ScreenUpdating = False


    End Sub
    Mutasd a teljes hozzászólást!
  • Szia!

    még így is csak a j 1. rekkordjához hasonlít mindent.

    Hiszen pontosan ezt adod neki utasításba... ha az első tétellel nem egyezik, akkor írja be a variációt.
    Pedig később még lehetne egyezés - sőt van is ugye.
    Tehát mielőtt beírod a hasonlított variációt a sorba, végig kell nézni az összes már meglevőt. Azaz a beírást a belső cikluson kívülre kell tenni. Azért, hogy a meglevőt ne írja be, az egyezőséget egy flaggal jelölni kell és úgy kilépni a ciklusból. A ciklus után pedig a flag állapota alapján vagy beírod vagy nem az adott variációt. 
    Talán a folyamatábrád is revízióra szorul ...
    Üdv.
    Mutasd a teljes hozzászólást!
  • Bevallom, csak a töredékét értem annak, amit most leírtál.
    Üdv,
    Mutasd a teljes hozzászólást!
  • Szia!
    Mi történik most a makródban:
    1. megnézed, hogy az első tétel egyezik-e a hasonlítottál. Ha nem, akkor beteszed a sor végére.....
    pedig akár a második már egyezhetne is.
    2 tehát meg kell nézni a másodikat - harmadikat is, hogy meggyőződj róla, benne van-e már a listában,  (ez a ciklus)
    és csak akkor hozzáadni, ha egyáltalán nincs benne és már végigértél a hasonlítással.
    3.ha pedig benne van, akkor nem kell hozzáadni,, ezért ha megtalálod benne, akkor át kell ugrani a hozzáadást.
    Pl   nincsbenne=true
          for ---
               if egyforma then nincsbenne=false:exit for
          next
          if nincsbenne then hozzáadod
    Ez csak példa, a konkrét feltételeket neked kell beírni.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia,
    Sajnos ezt nem igazán tudom értelmezni.
    Próbáltam valamit beírni ez alapján a makróba, de mindig hibát hoz ki.

    Sheets("Műveletek").Select
    Dim usor1 As Long
    usor1 = Range("E1").End(xlDown).Row


    Dim i As Long, j As Long
    For i = 2 To usor1

    Sheets("Munka kiosztás").Select
    Dim usor2 As Long
    usor2 = Range("A1").End(xlDown).Row
    Dim esor2 As Long
    esor2 = usor2 + 1
    Dim Flag As Boolean
    Dim con As Variant

    Flag = True
    On Error Resume Next
    For j = 2 To usor2

    con = (((ActiveWorkbook.Sheets("Műveletek").Cells(i, 5) & ActiveWorkbook.Sheets("Műveletek").Cells(i, 6)) = _
    (ActiveSheet.Cells(j, 1) & ActiveSheet.Cells(j, 2))) And ActiveSheet.Cells(j, 3).Value <> "Elmaradt")
    If con Is Nothing Then
    Flag = False
    Exit For
    Next j
    If Flag = True Then
    ActiveSheet.Cells(esor2, 1) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 5).Value
    ActiveSheet.Cells(esor2, 2) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 6).Value
    ActiveSheet.Cells(esor2, 3).Value = "Folyamatban"
    Sheets("Munka kiosztás").Select
    End If

    Next i
    Mutasd a teljes hozzászólást!
  • Szia!

    Túlkombináltad.....

    Sub Kiosztas() Application.ScreenUpdating = False Sheets("Műveletek").Select usor1 = Range("E1").End(xlDown).Row Dim i As Long, j As Long, flag As Boolean For i = 2 To usor1 flag = True Sheets("Munka kiosztás").Select usor2 = Range("A1").End(xlDown).Row esor2 = usor2 + 1 For j = 2 To usor2 If ActiveWorkbook.Sheets("Műveletek").Cells(i, 5) = ActiveSheet.Cells(j, 1) And ActiveWorkbook.Sheets("Műveletek").Cells(i, 6) = ActiveSheet.Cells(j, 2) And ActiveSheet.Cells(i, 3).Value <> "Elmaradt" Then flag = False: Exit For End If Next j If flag Then ActiveSheet.Cells(esor2, 1) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 5).Value ActiveSheet.Cells(esor2, 2) = ActiveWorkbook.Sheets("Műveletek").Cells(i, 6).Value ActiveSheet.Cells(esor2, 3).Value = "Folyamatban" Sheets("Munka kioszt?s").Select End If Next i Sheets("Munka kiosztás").Activate Application.ScreenUpdating = True End Sub
    Üdv.
    Ps. Használd a forráskód (</>) gombot a makrókhoz légy szíves.
    Mutasd a teljes hozzászólást!
  • Szia,
    Nagyon köszönöm, így már értem.
    Megy a pont.
    Üdv,
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd