Hirdetés

  2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    LOGOUT

    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

  • #20187 Delila_1 veterán Attas #20184
    Új Válasz #20187
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Delila_1

    veterán

    válasz Attas #20184 üzenetére

    Azt nem írtad, hogy ha a B oszlopból választasz kigyűjtendő adatot, hova írja. Úgy írtam meg a makrót, hogy B választáskor a Munka2, C-nél pedig a Munka1 lapra gyűjtsön ki.
    Az adatokat az Adatok lap tartalmazza. Ezt kell átírnod a makróban 2 helyen a saját lapod nevére.

    Sub Atmasol()
    Dim WS As Worksheet, sor As Long, usor As Long, v$, WF As WorksheetFunction
    Dim oszlop As Integer, sor1 As Long, f As Boolean

    Application.ScreenUpdating = False

    Set WF = Application.WorksheetFunction
    Sheets("Adatok").Activate

    v$ = Application.InputBox("B, vagy C oszlop szerint akarsz másolni?", "Oszlop választás", , , , , , 2)
    If v$ = "B" Or v$ = "b" Then
    Set WS = Sheets("Munka2")
    oszlop = 2
    v$ = Application.InputBox("Kérem a keresendő B értéket", "Adat választás", , , , , , 2)
    GoTo Keres
    End If

    If v$ = "C" Or v$ = "c" Then
    Set WS = Sheets("Munka1")
    oszlop = 3
    v$ = Application.InputBox("Kérem a keresendő C értéket", "Adat választás", , , , , , 2)
    GoTo Keres
    End If

    MsgBox "B vagy C értéket írhatsz", vbOKOnly + vbExclamation
    Exit Sub

    Keres:
    usor = WF.CountA(Columns(oszlop))
    f = False
    For sor = 1 To usor
    If Cells(sor, oszlop) = v$ Then
    If WS.Range("C6") = "" Then sor1 = 6 Else sor1 = WS.Range("C" & Rows.Count).End(xlUp).Row + 1
    Cells(sor, "D").Copy WS.Cells(sor1, "C")
    f = True
    End If
    Next

    'Rendezés
    WS.Activate
    Range("C6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

    Sheets("Adatok").Activate
    Application.ScreenUpdating = True

    If f = False Then MsgBox "Nincs a tartományban " & v$ & " érték", vbOKOnly
    End Sub

Új hozzászólás Aktív témák