Excel VBA – найдите соответствующие заголовки столбцов и удалите столбец

Извиняюсь, если раньше был дан ответ, я не могу найти что-либо, что соответствует моему конкретному делу.

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

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

Дайте мне знать, если вам нужна дополнительная информация, и спасибо за помощь!

Что я до сих пор, код делает некоторые другие вещи, так что это нужно продолжать работать.

Sub RemoveExtras() Dim MyRange As Range Dim ws As Worksheet Application.ScreenUpdating = False Application.Calculation = xlCalculationManual BadCharacters = Array(Chr(10), Chr(13)) wsNumber = Sheets.Count For Each ws In Worksheets With ws For Each MyRange In .UsedRange If 0 < InStr(MyRange, Chr(10)) Then For Each i In BadCharacters MyRange = Replace(MyRange, i, vbNullString) Next i End If For t = 1 To wsNumber Columns(t).RemoveDuplicates Columns:=Array(1), Header:=xlYes Next t Next MyRange End With Next ws Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Словари идеально подходят для обработки уникальных значений:

 Sub RemoveExtras() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim c As Integer, i As Integer, ws As Worksheet Dim dict As Object For Each ws In Worksheets Set dict = CreateObject("Scripting.Dictionary") 'Find Last column c = ws.UsedRange.Columns.Count 'Loop backwards For i = c To 2 Step -1 'If column does not exist in dictionary, then add it If Not dict.Exists(ws.Cells(2, i).Value) Then dict.Add ws.Cells(2, i).Value, 1 Else 'Otherwise delete column ws.Columns(i).Delete Shift:=xlToLeft End If Next i Set dict = Nothing Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Здесь вы не сравниваете каждую пару заголовков столбцов на листе. Также это сравнивает заголовки по всем листам, а не только дублирует внутри одного отдельного листа.

Посмотрите, поможет ли это вам

 Sub test() Dim book As Workbook, sheet As Worksheet, text As String For Each sheet In Worksheets Set MR = Range("B2:Z2") 'change Z2 as per your requirement For Each cell In MR Set BR = Range("B2:Z2") 'change Z2 as per your requirement For Each cell2 In BR If cell.Value = cell2.Value Then cell.EntireColumn.Delete Next Next Next sheet End Sub 
Interesting Posts

VBA: данные таблицы фильтров основаны на выпадающем выборе

Настройка фонового пользовательского цвета, не работающего для XSSF в Apache POI

Excel VBA вставляет переменную массива в одно поле в доступе

Создание цикла для заполнения XML-файла в блокноте в Excel VBA

Как очистить кеш браузера клиента для надстройки панели задач Excel 2016 на Mac?

Преобразование рабочего листа Excel в CSV и сохранение имени файла в TXT. Пропустить имя файла для будущего выполнения скрипта

Событие Excel OnChange

Импорт данных из excel с использованием структуры в Matlab?

Когда B2 = B1 AND C2 = C1, результат возврата 1

Код VBA для преобразования PDF в Txt (Adobe acrobat XI Pro)

Ошибка VBA: этот ключ уже связан с элементом этой коллекции

Использование VBA для отслеживания изменений в Excel – Предложения?

Openpyxl: Уменьшить из существующей книги

Excel Macro для поиска файлов на основе ключевого слова и возврата true, если они присутствуют

Определите сравнение между двумя столбцами VBA

Давайте будем гением компьютера.