Hirdetés

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

  • huliganboy

    addikt

    Szerintetek ez miért nem működik nekem? Egy oldalon találtam, azt hittem megoldás a problémámra.

    Feladat: C oszlop második cellájától a cellákban levő értékeket vizsgálni, és ha van azonos akkor a hozzá tartozó sorokat törölni, egy kivételével!

    Sub RemoveDuplicatesCells_EntireRow()
    'PURPOSE: Remove the entire row of duplicate cell values within a selected cell range
    'SOURCE: www.TheSpreadsheetGuru.com

    Dim rng As Range
    Dim x As Integer

    'Optimize code execution speed
    Application.ScreenUpdating = False

    'Determine range to look at from user's selection
    On Error GoTo InvalidSelection
    Set rng = Selection
    On Error GoTo 0

    'Ask user which column to look at when analyzing duplicates
    On Error GoTo InputCancel
    x = InputBox("Which column should I look at? (Number only!)", _
    "Select A Column", 1)
    On Error GoTo 0

    'Optimize code execution speed
    Application.Calculation = xlCalculationManual

    'Remove entire row if duplicate is found
    rng.EntireRow.RemoveDuplicates Columns:=x

    'Change calculation setting to Automatic
    Application.Calculation = xlCalculationAutomatic

    Exit Sub

    'ERROR HANDLING
    InvalidSelection:
    MsgBox "You selection is not valid", vbInformation
    Exit Sub

    InputCancel:

    End Sub

    Köszi! :R

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