Telefonszámunk: 1-472-0679

feladatok egy gombra összpontosítása

Kezdőlap Fórumok Excel programozás feladatok egy gombra összpontosítása

5 bejegyzés megtekintése - 1-5 / 5
  • Szerző
    Bejegyzés
  • #5157
    Potus
    Felhasználó

      Sziasztok!

      A már annyiszor idecitált „program”-omról lenne ismét szó.
      Találtam a neten egy remek szűrő programot, makrót, nem is tudom hogyan nevezzem, amit kissé átalakítgatva több dologra is tudok használni. Többek között arra is, hogy felviszem a különböző feladatokat , találkozókat, határidőket stb egy táblázatba – rendezi sem kell őket dátum szerint – és kiszűri az adatokat a kért kritérium szerint.
      Amiről most szó van az megjeleniti a „mai” dátumhoz kapcsolodó feladatokat egy – ill. most még kettő – kattintásra. Abban szeretnék segítséget kérni, hogy ez a két kattintás egy legyen.
      Most jelen pillanatban a nyító lapon rákattintok egy gombra az előhívja a userformot és még egyet kattintanom kell, hogy az adatok is megjelenjenek. Szeretném, ha ez egy kattintással megoldható lenne.

      a kód, a macro:
      Sub cmdMa_Click()

      Application.screenupdating = False
      Sheets(„adat”).Select
      Range(„B8:G209”).Select
      Selection.copy

      Range(„CQ8”).Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

      Dim DataSH As Worksheet
      On Error GoTo errhandler:

      Set DataSH = Sheets(„adat”)
      DataSH.Range(„cy8”).Value = Sheets(„adat”).Range(„b2”)
      DataSH.Range(„cy9”).Value = Sheets(„adat”).Range(„b1”)
      DataSH.Range(„cq8”).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DataSH.Range(„adat!criteria4”) _
      , CopyToRange:=DataSH.Range(„adat!extract4”)
      ‘Set myRng = Sheet1.Range(„outdata”)
      lboMa.RowSource = Sheets(„adat”).Range(„outdata4″).Address(external:=True)
      Exit Sub
      errhandler:
      ‘if error occurs then show me exactly where the error occurs
      Call msgbox5.show ‘”No match found for ” & txtSearch.Text
      On Error GoTo 0
      Exit Sub
      Application.screenupdating = True

      End Sub

      Private Sub lboMa_Click()
      Me.txtDate.Value = Me.lboMa.Value
      Me.txtMonth.Value = Me.lboMa.Column(1)
      Me.txtTali.Value = Me.lboMa.Column(2)
      Me.txthido.Value = Me.lboMa.Column(3)
      Me.txtFeladat.Value = Me.lboMa.Column(4)
      Me.txtID.Value = Me.lboMa.Column(5)
      End Sub

      Private Sub UserForm_Click()

      End Sub

      előre is köszönöm a segítséget! Üdv.: Potus

      #5158
      Potus
      Felhasználó

        Attachments:
        You must be logged in to view attached files.
        #5181
        Titok
        Felhasználó

          Beírod az első végére, hogy Call lboMa_Click()???

          #5215
          Potus
          Felhasználó

            BEÍRTAM, SEMMI VÁLTOZÁS. AZ NEM GOND, HOGY AZ EGYIK SUB A MÁSIK PRIVATE SUB? KIPROBÁLTAM ÚGY IS, HOGY MINDKETTŐ SUB, DE ÚGY SINCS VÁLTOZÁS.
            Sub cmdMa_Click()

            Application.screenupdating = False
            Sheets(„adat”).Select
            Range(„B8:G209”).Select
            Selection.copy

            Range(„CQ8”).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

            Dim DataSH As Worksheet
            On Error GoTo errhandler:

            Set DataSH = Sheets(„adat”)
            DataSH.Range(„cy8”).Value = Sheets(„adat”).Range(„b2”)
            DataSH.Range(„cy9”).Value = Sheets(„adat”).Range(„b1”)
            DataSH.Range(„cq8”).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DataSH.Range(„adat!criteria4”) _
            , CopyToRange:=DataSH.Range(„adat!extract4”)
            ‘Set myRng = Sheet1.Range(„outdata”)
            lboMa.RowSource = Sheets(„adat”).Range(„outdata4″).Address(external:=True)
            Exit Sub
            errhandler:
            ‘if error occurs then show me exactly where the error occurs
            Call msgbox5.show ‘”No match found for ” & txtSearch.Text
            On Error GoTo 0
            Exit Sub
            Application.screenupdating = True
            Call lboMa_Click
            End Sub

            Private Sub lboMa_Click()
            Me.txtDate.Value = Me.lboMa.Value
            Me.txtMonth.Value = Me.lboMa.Column(1)
            Me.txtTali.Value = Me.lboMa.Column(2)
            Me.txthido.Value = Me.lboMa.Column(3)
            Me.txtFeladat.Value = Me.lboMa.Column(4)
            Me.txtID.Value = Me.lboMa.Column(5)
            End Sub

            #5332
            lndz
            Felhasználó

              Sziasztok!

              Most beleokoskodok.:)
              Ez mehetne az elejére:
              Dim DataSH As Worksheet
              On Error GoTo errhandler:

              Set DataSH = Sheets(“adat”)

              Nem vagyok benne biztos, de szerintem nem kell selectálni copyhoz
              Sheets(“adat”).Select
              Range(“B8:G209”).Select
              Selection.copy
              helyett:
              DataSH.Range(“B8:G209”).copy
              az se biztos hogy érdemes copy-zni
              helyette:
              DataSH.Range(“CQ8”).resize(DataSH.Range(“B8:G209”).rows.count, DataSH.Range(“B8:G209”).columns.count).value=DataSH.Range(“B8:G209”)
              persze a DataSH.Range(“B8:G209”) tartomány hozzárendelhető változóhoz, akkor jobban néz ki.
              Nem szeretem (nem is használom sose) a RowSource tulajdonságot.:)
              Próbáltad már a list-et helyette?
              Ha van egy ranged, amit hozzárendelsz egy variant típusú változóhoz tömb lesz belőle a listbox.list tulajdonság egy tömböt vár.
              azért is jobb szerintem a list, mert nem csak range-ből jöhetnek az értékek, de abból is.
              Az eredeti kérdésre nem tudok válaszolni, azt nem értem.:)

              Köszönöm,
              Zoli

            5 bejegyzés megtekintése - 1-5 / 5
            • Be kell jelentkezni a hozzászóláshoz.