Dror hat ein Arbeitsblatt, das eine Menge Daten enthält. Es ist möglich, dass die Daten in einer Spalte genau mit den Daten in einer anderen Spalte übereinstimmen. Er fragt sich daher, ob es eine einfache Möglichkeit gibt, doppelte Spalten im Arbeitsblatt zu löschen.

Der erste Schritt besteht natürlich darin, herauszufinden, ob zwei Spalten identisch sind oder nicht. Dies kann ziemlich einfach mit einer Array-Formel wie der folgenden bestimmt werden:

=AND(A1:A100=B1:B100)

(Denken Sie daran, dass eine Array-Formel mit Umschalt + Strg + Eingabetaste eingegeben wird.)

Die Formel vergleicht alle Werte in den ersten 100 Zeilen der Spalten A und B. Wenn sie alle gleich sind, gibt die Formel TRUE zurück. Wenn eine der Zellen nicht übereinstimmt, gibt die Formel FALSE zurück. Wenn das Ergebnis TRUE ist, können Sie eine der Spalten löschen, da sie identisch sind.

Wenn Sie etwas möchten, das etwas automatischer ist, was bedeutet, dass die doppelte Spalte gelöscht wird, müssen Sie ein Makro verwenden. In den folgenden Schritten werden alle Spalten im Arbeitsblatt durchlaufen und beginnend mit der Spalte ganz rechts alle Spalten verglichen. Wenn einige identisch sind – unabhängig von ihrer Reihenfolge im Arbeitsblatt -, werden Sie vom Makro gefragt, ob die doppelte Spalte gelöscht werden soll.

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

_Hinweis: _

Wenn Sie wissen möchten, wie die auf dieser Seite (oder auf einer anderen Seite der ExcelTips-Websites) beschriebenen Makros verwendet werden, habe ich eine spezielle Seite vorbereitet, die hilfreiche Informationen enthält.

Klicken Sie hier, um diese spezielle Seite in einem neuen Browser-Tab zu öffnen.

ExcelTips ist Ihre Quelle für kostengünstige Microsoft Excel-Schulungen.

Dieser Tipp (7164) gilt für Microsoft Excel 97, 2000, 2002 und 2003. Eine Version dieses Tipps für die Multifunktionsleistenschnittstelle von Excel (Excel 2007 und höher) finden Sie hier:

Löschen doppelter Spalten.