У Dror есть рабочий лист, содержащий довольно много данных. Возможно, что данные в одном столбце будут точно такими же, как данные в другом столбце, поэтому он задается вопросом, есть ли простой способ удалить любые повторяющиеся столбцы на листе.

Первый шаг, конечно же, — выяснить, идентичны ли два столбца или нет. Это можно довольно легко определить с помощью формулы массива, такой как:

=AND(A1:A100=B1:B100)

(Помните, что формула массива вводится с помощью Shift + Ctrl + Enter.)

Формула сравнивает все значения в первых 100 строках столбцов A и B. Если они все одинаковы, формула возвращает ИСТИНА. Если какая-либо из ячеек не совпадает, формула возвращает ЛОЖЬ. Если результат ИСТИНА, вы можете удалить один из столбцов, потому что они одинаковы.

Если вы хотите что-то более автоматическое, то есть удалить повторяющийся столбец, вам нужно будет использовать макрос. Следующие шаги проходят по всем столбцам на листе и, начиная с самого правого столбца, сравнивают все столбцы. Если какие-либо из них совпадают — независимо от их порядка на листе, — макрос спрашивает, хотите ли вы удалить повторяющийся столбец.

Sub DeleteDuplicateColumns()

Dim rngData As Range     Dim arr1, arr2     Dim i As Integer, j As Integer, n As Integer

On Error Resume Next     Set rngData = ActiveSheet.UsedRange     If rngData Is Nothing Then Exit Sub

n = rngData.Columns.Count

For i = n To 2 Step -1         For j = i - 1 To 1 Step -1             If WorksheetFunction.CountA(rngData.Columns(i)) <> 0 And _               WorksheetFunction.CountA(rngData.Columns(j)) <> 0 Then                 arr1 = rngData.Columns(i)

arr2 = rngData.Columns(j)

If AreEqualArr(arr1, arr2) Then                     With rngData.Columns(j)

'mark column to be deleted                         .Copy                         If MsgBox("Delete marked column?", vbYesNo) _                           = vbYes Then                             rngData.Columns(j).Delete                         Else                             'remove mark                             Application.CutCopyMode = False                         End If                     End With                 End If             End If         Next j     Next i

End Sub
Function AreEqualArr(arr1, arr2) As Boolean     Dim i As Long, n As Long     AreEqualArr = False     For n = LBound(arr1) To UBound(arr1)

If arr1(n, 1) <> arr2(n, 1) Then             Exit Function         End If     Next n     AreEqualArr = True End Function

_Примечание: _

Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (5674) применим к Microsoft Excel 2007, 2010, 2013, 2016, 2019 и Excel в Office 365. Вы можете найти версию этого совета для старого интерфейса меню Excel здесь:

link: / excel-Deleting_Duplicate_Columns [Удаление повторяющихся столбцов].