Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удалить дубликаты чисел, в активном столбце с сортировкой чисел
 
#1
23.06.2016 10:15:28
Здравствуйте, есть код макроса для удаления дубликатов, в нем нужно дописать, вывод сообщения об удаленных и количество удалений
Кроме этого он еще и сортирует числа, но сортирует только в A столбце, как выставить сортировку в активном выделенном столбце начиная с 2 строки, т.е. не затрагивая заголовок
 
 
 
#2
23.06.2016 10:46:15
Код
Sub Udalenie_Dublikatov_Yacheek()
'ìàêðîñ óäàëÿåò ÿ÷åéêè, åñëè íàõîäèò äóáëèêàòû
Dim iCount As Long, i As Long, j As Long, k As Long
Dim Str1 As String, Str2 As String
Dim Group As Range
Dim x As Integer '!!!
x = 0 '!!!
k = Selection.Column
iCount = Cells(Rows.Count, k).End(xlUp).Row
    For i = 2 To iCount
        Str1 = CStr(Selection.Cells(i).Value)
            If Str1 <> "" Then
                For j = i To iCount
                    Str2 = CStr(Selection.Cells(j).Value)
                        If i <> j And Str1 = Str2 Then
                        x = x + 1 '!!!
                            If Group Is Nothing Then _
                                Set Group = Selection.Cells(j) Else Set Group = Union(Group, Selection.Cells(j))
                        End If
                Next j
            End If
    Next i
On Error Resume Next
Group.Delete shift:=xlUp
[A:A].Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes
MsgBox x '!!!
End Sub
Код

				

					
		

		

			
				

				 
				

					
			
				

 				

					
		

	





	
		

			
				 				
			
			
				

					
#3

										23.06.2016 13:43:15
				

				

					
U_M0KRH, спасибо, показало количество удалений, а можно именно что удалил добавить и упорядочить выделенный столбец
Код
Sub Udalenie_Dublikatov_Yacheek()
'макрос удаляет ячейки, если находит дубликаты
Dim iCount As Long, i As Long, j As Long, k As Long
Dim Str1 As String, Str2 As String
Dim Group As Range
Dim x As Integer '!!!
x = 0 '!!!
k = Selection.Column
iCount = Cells(Rows.Count, k).End(xlUp).Row
    For i = 2 To iCount
        Str1 = CStr(Selection.Cells(i).Value)
            If Str1 <> "" Then
                For j = i To iCount
                    Str2 = CStr(Selection.Cells(j).Value)
                        If i <> j And Str1 = Str2 Then
                        x = x + 1 '!!!
                            If Group Is Nothing Then _
                                Set Group = Selection.Cells(j) Else Set Group = Union(Group, Selection.Cells(j))
                        End If
                Next j
            End If
    Next i
On Error Resume Next
Group.Delete shift:=xlUp
[A:A].Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes
MsgBox "удалено " & x & " шт." '!!!
End Sub



этот код сортировки сделать не привязанным к столбцу A, сделать его в выделенной строке
Код
[A:A].Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes



					Изменено:						next777pro - 23.06.2016 13:50:55
				
				

					
		

		

			
				

				 
				

					
			
				

 				

					
		

	
				
					

						
							
							 


								
					

				
			

		

	





	

			Страницы:
		1
	

	







	

		

			

			
			
			
			
			

		

		

	



				

	

		

	























































    Наверх