Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как поменять значение соседних ячеек местами
 
#1
27.07.2010 12:31:26
Есть необходимость менять значение ячеек в соседних столбцах местами, встроенной функции вроде нет, как это сделать ?
 
 
 
#2
27.07.2010 12:34:29

http://www.planetaexcel.ru/forum.php/?thread_id=11495
 
 
 
#3
27.07.2010 12:40:14
Можно простеньким макросом. Значения в А1 и В1.  
Sub Macro1()  
Dim x, y  
x = Cells(1, 1)  
y = Cells(1, 2)  
Cells(1, 2) = x  
Cells(1, 1) = y  
End Sub
 
 
 
#4
27.07.2010 12:46:27
Если нужно вставить туда-же назад только значения, можно попытаться сделать на массивах - берём выделенное в массив (или массивы), запрашиваем порядок выгрузки, выгружаем. Это так предварительно, не продумывая пока детали. Может что и не сойдётся...
 
 
 
#5
27.07.2010 12:55:53
Юрий М.  
Чет оно у меня не работает, как его прикрутить? и чтоб делало с выделенными ячейками?
 
 
 
#6
27.07.2010 12:59:34
Юрий М.  
Извиняюсь, запарился, не в ту книгу макрос поместил.  
Да, это то, что надо, такое простенькое, в основном придется менять два значения в соседних столбцах, минимальное кол-во данных, а как это сделать чтоб с выделенными ячейками работало
 
 
 
#7
27.07.2010 14:49:46
Куда все пропали??
 
 
 
#8
27.07.2010 15:09:09
Если строго в одном ряду, в одном блоке выделения, меняем местами крайние - модификачия пред.кода:  
 
Sub Macro1()  
Dim x, y  
x = Cells(Selection.Row, Selection.Column)  
y = Cells(Selection.Row, Selection.Column + Selection.Columns.Count - 1)  
Cells(Selection.Row, Selection.Column + Selection.Columns.Count - 1) = x  
Cells(Selection.Row, Selection.Column) = y  
End Sub
 
 
 
#9
27.07.2010 15:21:07
ДА, да, то, что надо, спасибо!!!
 
 
 
#10
27.07.2010 16:31:55
Мож кому пригодится. Меняет местами любые две выделенные ячейки, не обязательно смежные.  
 
Sub SwapCells()  
Dim bSecond As Boolean, rX As Range, r2 As Range, v  
If Selection.Cells.Count <> 2 Then MsgBox "Число выделенных ячеек не равно 2.", vbCritical: Exit Sub  
For Each rX In Selection.Cells  
   If bSecond Then  
       v = rX  
       r2.Copy rX  
       r2 = v  
   Else  
       bSecond = True  
       Set r2 = rX  
   End If  
Next  
End Sub
 
 
 
#11
10.09.2012 15:46:23
спасибо! но в данном случае он менят только 2. А как нужно исправить код, чтобы менять местами области выделения?
 
 
 
#12
11.09.2012 08:20:19
Достаточно сделать замену "cell" на "area", и оно уже работает :)  
 
Sub SwapAreas()  
Dim bSecond As Boolean, rX As Range, r2 As Range, v  
If Selection.Areas.Count <> 2 Then MsgBox "Число выделенных областей не равно 2.", vbCritical: Exit Sub  
For Each rX In Selection.Areas  
   If bSecond Then  
       v = rX  
       r2.Copy rX  
       r2 = v  
   Else  
       bSecond = True  
       Set r2 = rX  
   End If  
Next  
End Sub
 
 
 
#13
11.09.2012 08:34:27
В случае областей даже проще, их не надо перебирать через For Each, а можно обращаться непосредственно (с ячейками так не получается).  
Добавил проверку размеров областей:  
 
 
Sub SwapAreas2()  
Dim a1 As Range, a2 As Range, v  
If Selection.Areas.Count <> 2 Then MsgBox "Число выделенных областей не равно 2.", vbCritical: Exit Sub  
Set a1 = Selection.Areas(1)  
Set a2 = Selection.Areas(2)  
If a1.Rows.Count <> a2.Rows.Count Or a1.Columns.Count <> a2.Columns.Count Then _  
   If MsgBox("Размеры выделенных областей не совпадают. Продолжить?", _  
       vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then Exit Sub  
v = a2.Value  
a1.Copy a2.Cells(1)  
a1.Value = v  
End Sub
 
 
 
#14
11.09.2012 09:35:11
Получается для двух ячеек без For Each:  
Sub SwapAreas3()  
Dim a1 As Range, a2 As Range, v  
If Selection.Areas.Count <> 2 Then MsgBox "Число выделенных областей не равно 2.", vbCritical: Exit Sub  
Set a1 = Selection.Areas(1)  
Set a2 = Selection.Areas(2)  
If a1.Count <> a2.Count Then Exit Sub  
v = a2.Value  
a1.Copy a2.Cells(1)  
a1.Value = v  
End Sub
 
 
 
#15
11.09.2012 10:39:51
Да, разумеется, Area может состоять из одной ячейки :)  
Я имел в виду то, что вторую ячейку выделения нельзя получить как .Cells(2).  
В общем, получается так:  
 
Sub SwapAreas4()  
Dim a1 As Range, a2 As Range, v  
If TypeName(Selection) <> "Range" Then MsgBox "Выделенный объект не является диапазоном.", vbCritical: Exit Sub  
With Selection  
   Select Case .Areas.Count  
   Case 1 '1 область  
       If .Cells.Count <> 2 Then MsgBox "Число выделенных ячеек не равно 2.", vbCritical: Exit Sub  
       Set a1 = .Cells(1)  
       For Each a2 In .Cells  
           v = v + 1  
           If v = 2 Then Exit For  
       Next  
   Case 2 '2 области  
       Set a1 = .Areas(1)  
       Set a2 = .Areas(2)  
       If a1.Rows.Count <> a2.Rows.Count Or a1.Columns.Count <> a2.Columns.Count Then _  
           If MsgBox("Размеры выделенных областей не совпадают. Продолжить?", _  
               vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then Exit Sub  
   Case Else  
       MsgBox "Число выделенных областей не равно 2.", vbCritical: Exit Sub  
   End Select  
End With  
v = a2.Value  
a1.Copy a2.Cells(1)  
a1.Value = v  
End Sub
 
 
 
#16
11.09.2012 10:47:00
Этот кусок  
 
       Set a1 = .Cells(1)  
       For Each a2 In .Cells  
           v = v + 1  
           If v = 2 Then Exit For  
       Next  
 
можно сократить :)  
 
       For Each a2 In .Cells  
           If v Then Exit For Else Set a1 = a2: v = 1  
       Next
 
 
 
Страницы: 1
Читают тему
Наверх