Страницы: 1
RSS
Сортировка значений столбцов относительно соседнего
 
Имеются столбцы А, В, С. Столбец А постоянен. Столбцы В и С связаны друг с другом жестко, т.е. значениям столбца В соответствуют значения столбца С. В столбцах А и В находятся чсла одинаковые по смыслу, но различные по порядку сортировки.  
Необходимо отсортировать значения в столбце В так, что бы они соответствовали столбцу А и при этом столбцы В и С не теряли взаимосвязи между собой.  
Пример прикреплен.
 
1. Я знаю сортировку либо по убыванию, либо по возрастанию. А у Вас какая сортировка?  
2. Числа в столбце А могут повторяться?
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Не очень понятно: "числа одинаковые по смыслу". По значению?  
Может вот это подойдет  
 
Sub ert()  
Dim i&, r As Range  
Application.ScreenUpdating = 0  
With Range("A1").CurrentRegion  
   For i = 1 To .Rows.Count  
       If .Cells(i, 1) <> .Cells(i, 2) Then  
           Set r = .Columns(2).Find(.Cells(i, 1), after:=.Cells(i, 2), lookat:=xlWhole)  
           If Not r Is Nothing Then  
               r.Resize(, 2).Cut  
               .Cells(i, 2).Resize(, 2).Insert  
           End If  
       End If  
   Next i  
End With  
Application.ScreenUpdating = 1  
End Sub
 
1. Если не могут, тогда    
в G1 и в F1 формулу: =$A1 и протянуть  
в H1 формулу: =ВПР(G1;$B$1:$C$24;2;0) и протянуть  
 
2. У вас в столбце H - три нуля. А в столбце D - два нуля. Это противоречит Вашему же заданию.
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
{quote}{login=nilem}{date=21.07.2012 03:31}{thema=}{post}Не очень понятно: "числа одинаковые по смыслу". По значению?  
Может вот это подойдет  
 
Sub ert()  
Dim i&, r As Range  
Application.ScreenUpdating = 0  
With Range("A1").CurrentRegion  
   For i = 1 To .Rows.Count  
       If .Cells(i, 1) <> .Cells(i, 2) Then  
           Set r = .Columns(2).Find(.Cells(i, 1), after:=.Cells(i, 2), lookat:=xlWhole)  
           If Not r Is Nothing Then  
               r.Resize(, 2).Cut  
               .Cells(i, 2).Resize(, 2).Insert  
           End If  
       End If  
   Next i  
End With  
Application.ScreenUpdating = 1  
End Sub{/post}{/quote}
 
Всем спасибо!  
Макрос помог!  
И формула тоже!  
Еще раз всем спасибо!!
Страницы: 1
Читают тему
Наверх