Excel VBA – 查找匹配的列标题并删除列

道歉，如果这之前已经回答，我无法find任何符合我的具体情况。

我有一张18页的工作簿，从B2开始，每张表有不同数量的列。 有时生成工作表的程序将创build重复列，由于这个原因，我需要一个由button触发的macros来search每个工作表匹配的列标题，然后删除这些列中的一个（整个列，不只是标题）。

到目前为止，我很困难，我已经能够从工作表中的任何单元格中删除所有匹配，这几乎擦除了整个工作表。 我只需要匹配标题，然后删除整个列的基础上。

如果您需要更多信息，请告知我，并感谢您的帮助！

我到目前为止，代码还在做其他一些东西，所以这需要继续工作。

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 

Answer 1

字典对处理独特的价值是完美的：

 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 

在这里你不要比较工作表中的每一列标题。 此外，这将比较所有工作表中的标题，而不仅仅是在单个工作表内重复。

Answer 2

看看这是否有助于你

 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