Очистка повторяющихся значений в строке в выбранном диапазоне - PullRequest
0 голосов
/ 01 мая 2018

Это мой первый раз здесь

У меня есть код, который может удалять и повторять значения, которые когда-то были объединены в пределах диапазона выбора, чтобы я мог применить фильтр к данным. (см. ниже)

Sub mergefiltro()

If MsgBox("select the desired range ?", vbYesNo) = vbNo Then Exit Sub

 Dim MergedCell As Range, FirstAddress As String, MergeAddress As String, MergeValue As Variant

 Application.FindFormat.MergeCells = True

Application.ScreenUpdating = False

   Do

     Set MergedCell = Selection.Find("", LookAt:=xlPart, SearchFormat:=True)

     If MergedCell Is Nothing Then Exit Do

     MergeValue = MergedCell.Value

     MergeAddress = MergedCell.MergeArea.Address

     MergedCell.MergeArea.UnMerge

     Range(MergeAddress).Value = MergeValue

   Loop

 Application.FindFormat.Clear
Application.ScreenUpdating = True

'Filter application

Selection.AutoFilter

End Sub

Этот код будет повторять значения, которые когда-то были в одной ячейке сиглы, которая была объединена с другими.

Теперь я не могу найти способ продолжить (в пределах того же выбора) очистить повторяющиеся значения ТОЛЬКО в строке ... Другими словами: я не хочу очищать все повторяющиеся значения ячеек в нисходящем направлении (по столбцам), только чтобы найти и очистить все повторяющиеся значения ячеек справа от листа Excel (в направлении строк).

Я сталкивался с этим:

Sub FindDups()

ScreenUpdating = False

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(0, 1).Value

Offsetcount = 1

Do While ActiveCell <> ""

If FirstItem = SecondItem Then

ActiveCell.Offset(Offsetcount, 0).Value = ("")

Offsetcount = Offsetcount + 1

SecondItem = ActiveCell.Offset(Offsetcount, 0).Value

Else

ActiveCell.Offset(Offsetcount, 0).Select

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

End If

Loop

ScreenUpdating = True

MsgBox "Done"

End Sub

Но этот код делает именно то, что я хочу: Clear - повторяющиеся значения в столбцах. То, что я хочу, это один код, который очищает повторяющиеся значения в строке (в правой части ячейки).

Кто-нибудь знает, как это сделать?

Заранее спасибо

Ответы [ 3 ]

0 голосов
/ 22 мая 2018

Я использую вариант со списком на одном листе и фильтром по базе данных, этот фильтр

'удалить макрос не показывать srceen ' Application.ScreenUpdating = False ' 'Список исключений для заголовка A1 и a2,3,4,5 для удаления Листы («Список исключений»). Выберите подсчитать исключения

d = ActiveWorkbook.Worksheets("Exception List").Range("A1", Range("A1").End(xlDown)).Rows.Count

'активировать базу данных для фильтрации Листы («1. Необработанные данные»). Активировать

'подсчитать данные базы данных (a3, потому что мой старт на a3, используйте все, что вам нужно) F = ActiveWorkbook.Worksheets ("1. Необработанные данные"). Диапазон ("A3", Диапазон ("A3"). Конец (xlDown)). Rows.Count + 2 'цикл для каждого исключения

For i = 2 To d
'exception loop taking
  Sheets("Exception List").Select
Criteria1 = Range("a" & i).Value

Sheets("1. Raw Data").Select
 'filter x exception in loop at data base ( A to Z in my case)
ActiveSheet.Range("$A$3:$Z$" & F).AutoFilter Field:=5, Criteria1:= _
    Criteria1
  'down one of visible rows ( form header to first visible data)
  Range("a3").Select
   With Worksheets("1. Raw Data").AutoFilter.Range
     Range("a" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(3).Row).Select

Окончание

   'select all data with exception
Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
    'erase exeptions
Selection.delete Shift:=xlUp
'erase filter
ActiveSheet.Range("$A$3:$Z$3").AutoFilter Field:=5

'следующее исключение Дальше я

Application.ScreenUpdating = True


'by christian marcos
0 голосов
/ 22 мая 2018
   sorry now on code everything
 > 'delete Macro dont show srceen
    > 
    > Application.ScreenUpdating = False
    > 
    > 
    > 'List of exception on A1 title and a2,3,4,5 to erase
    > 
    >  Sheets("sheet1").Select
    > 
    > 'count exceptions
    >    
    >     
    >     d = ActiveWorkbook.Worksheets("Exception List").Range("A1", Range("A1").End(xlDown)).Rows.Count
    >      
    >     'activate data base to filter   Sheets("1. Raw Data").Activate
    >       'count data base data ( a3 beacuse mine start at a3, use whatever you need)   F = ActiveWorkbook.Worksheets("1. Raw
    > Data").Range("A3", Range("A3").End(xlDown)).Rows.Count + 2   'loop for
    > each exception
    >   
    >     For i = 2 To d
    >     'exception loop taking
    >       Sheets("Exception List").Select
    >     Criteria1 = Range("a" & i).Value
    >     
    >     Sheets("1. Raw Data").Select
    >      'filter x exception in loop at data base
    >     ActiveSheet.Range("$A$3:$Z$" & F).AutoFilter Field:=5, Criteria1:= _
    >         Criteria1
    >       'down one of visible rows ( form header to first visible data)
    >       Range("a3").Select
    >        With Worksheets("1. Raw Data").AutoFilter.Range
    >          Range("a" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(3).Row).Select
    >           End With
    > 
    >        'select all data with exception
    >     Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
    >         'erase exeptions
    >     Selection.delete Shift:=xlUp
    >     'erase filter
    >     ActiveSheet.Range("$A$3:$Z$3").AutoFilter Field:=5 'next exception
    >     Next i
    >     
    >     Application.ScreenUpdating = True
    >     
    >     
    >     'by christian marcos
0 голосов
/ 01 мая 2018

Измените эту строку из вашего первого саб:

Range(MergeAddress).Value = MergeValue

до

Range(MergeAddress).Columns(1).Value = MergeValue
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...