Макрос Selection_eXchange позволяет обменять местами ТЕКСТ двух выбранных диапазонов или выделенных областей [vba]
Код
Sub Selection_eXchange() If Not TypeName(Selection) = "Range" Then Exit Sub Dim tmpVar1, tmpVar2 Dim tmpRng1 As Range, tmpRng2 As Range With Selection Select Case .Areas.Count Case 1 ' выделена 1 область If .Count = 2 Then ' выделено 2 ячейки Set tmpRng1 = .Cells(1): Set tmpRng2 = .Cells(2) ElseIf .Rows.Count = 2 And .Columns.Count > 2 Then ' выделен горизонтальный диапазон в 2 строки Set tmpRng1 = Range(Cells(.Row, .Column), Cells(.Row, .Column + .Columns.Count - 1)) ' 1-я строка диапазона Set tmpRng2 = tmpRng1.Offset(1, 0) ' 2-я строка ниже на 1 ElseIf .Columns.Count = 2 And .Rows.Count > 2 Then ' выделен вертикальный диапазон в 2 столбца Set tmpRng1 = Range(Cells(.Row, .Column), Cells(.Row + .Rows.Count - 1, .Column)) ' 1-й столбец Set tmpRng2 = tmpRng1.Offset(0, 1) ' 2-й столбец правее на 1 Else: Exit Sub End If Case 2 ' выделено 2 области If .Areas(1).Columns.Count = .Areas(2).Columns.Count And _ .Areas(1).Rows.Count = .Areas(2).Rows.Count Then ' одинаковая размерность областей Set tmpRng1 = .Areas(1): Set tmpRng2 = .Areas(2) End If Case Else: Exit Sub End Select End With Application.ScreenUpdating = False: Application.EnableEvents = False tmpVar1 = tmpRng1: tmpVar2 = tmpRng2 tmpRng1.Value = tmpVar2: tmpRng2.Value = tmpVar1 Application.EnableEvents = True: Application.ScreenUpdating = True End Sub
[/vba]
Макрос Selection_eXchange позволяет обменять местами ТЕКСТ двух выбранных диапазонов или выделенных областей [vba]
Код
Sub Selection_eXchange() If Not TypeName(Selection) = "Range" Then Exit Sub Dim tmpVar1, tmpVar2 Dim tmpRng1 As Range, tmpRng2 As Range With Selection Select Case .Areas.Count Case 1 ' выделена 1 область If .Count = 2 Then ' выделено 2 ячейки Set tmpRng1 = .Cells(1): Set tmpRng2 = .Cells(2) ElseIf .Rows.Count = 2 And .Columns.Count > 2 Then ' выделен горизонтальный диапазон в 2 строки Set tmpRng1 = Range(Cells(.Row, .Column), Cells(.Row, .Column + .Columns.Count - 1)) ' 1-я строка диапазона Set tmpRng2 = tmpRng1.Offset(1, 0) ' 2-я строка ниже на 1 ElseIf .Columns.Count = 2 And .Rows.Count > 2 Then ' выделен вертикальный диапазон в 2 столбца Set tmpRng1 = Range(Cells(.Row, .Column), Cells(.Row + .Rows.Count - 1, .Column)) ' 1-й столбец Set tmpRng2 = tmpRng1.Offset(0, 1) ' 2-й столбец правее на 1 Else: Exit Sub End If Case 2 ' выделено 2 области If .Areas(1).Columns.Count = .Areas(2).Columns.Count And _ .Areas(1).Rows.Count = .Areas(2).Rows.Count Then ' одинаковая размерность областей Set tmpRng1 = .Areas(1): Set tmpRng2 = .Areas(2) End If Case Else: Exit Sub End Select End With Application.ScreenUpdating = False: Application.EnableEvents = False tmpVar1 = tmpRng1: tmpVar2 = tmpRng2 tmpRng1.Value = tmpVar2: tmpRng2.Value = tmpVar1 Application.EnableEvents = True: Application.ScreenUpdating = True End Sub