Es kommt sehr häufig vor, dass Personen vertrauliche Daten in Excel-Arbeitsmappen speichern. Wenn diese Arbeitsmappen für andere Kollegen oder Freunde freigegeben werden müssen, ist das manuelle Löschen die einzige verfügbare Option. In diesem Artikel erfahren Sie jedoch, wie Sie vertrauliche oder unerwünschte Spalten schnell aus mehreren Arbeitsmappen löschen.
Laden Sie den WHS jetzt kostenlos herunter
Wenn du s willsttarUm die Software so schnell wie möglich zu verwenden, können Sie:
Laden Sie die Software jetzt herunter
Andernfalls können Sie den folgenden Inhalt lesen, wenn Sie selbst basteln möchten.
Bereiten wir die GUI vor
Benennen Sie das Blatt 1 wie in der Abbildung gezeigt in „ControlPanel“ um. Mithilfe von Formen würden wir diesem Blatt Schaltflächen hinzufügen, damit es als GUI (Graphical User Interface) für dieses Tool angezeigt wird. Wir brauchen drei Felder in dieser GUI. Feld1 soll die vom Benutzer ausgewählte Arbeitsmappe anzeigen. In Feld 2 werden Spalten aus der ausgewählten Arbeitsmappe als Dropdown-Liste angezeigt. Feld 3 ist eine Liste von Spalten, die aus der Arbeitsmappe entfernt werden sollen.
Wie funktioniert es?
Die Prozedur p_fpick würde es dem Benutzer ermöglichen, Excel-Dateien zu durchsuchen und auszuwählen. Sobald eine Excel-Datei ausgewählt ist, liest das Skript Spaltennamen aus Sheet1 und diese Namen werden als Dropdown-Liste angezeigt. Mit der Prozedur "Add_Column" kann der Benutzer den ausgewählten Spaltennamen aus der Dropdown-Liste hinzufügen, um ihn zur Liste der zu löschenden Spalten hinzuzufügen. Die letzte Prozedur "Delete_Columns" würde die Arbeitsmappe öffnen, die unter dem Feld "Select the workbook" aufgeführt ist, und alle ausgewählten Spalten entfernen. Nach dem Löschen wird die Arbeitsmappe gespeichert und geschlossen.
Sub P_fpick()
Dim v_fd As Office.FileDialog
Set v_fd = Application.FileDialog(msoFileDialogFilePicker)
With v_fd
.AllowMultiSelect = False
.Title = "Please select the Excel workbook"
.Filters.Clear
.Filters.Add "Excel", "*.xls*"
If .Show = True Then
cp.Range("B4").Value = .SelectedItems(1)
End If
End With
Dim wb As Workbook
Dim ab As Workbook
Set ab = ThisWorkbook
Set wb = Workbooks.Open(cp.Range("B4").Value)
Dim v_sheets As String
v_sheets = ""
Dim lc As Long
lc = wb.Sheets(1).Range("AZ1").End(xlToLeft).Column
Dim c As Long
For c = 1 To lc
If v_sheets = "" Then
v_sheets = wb.Sheets(1).Cells(1, c).Value
Else
v_sheets = v_sheets & "," & wb.Sheets(1).Cells(1, c).Value
End If
Next
wb.Close False
ab.Activate
With ab.Sheets(1).Range("N4:O5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=v_sheets
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Sub Add_Column()
If Range("Q4").Value = "" Then
Range("Q4").Value = Range("N4").Value
Else
Range("Q4").Value = Range("Q4").Value & "," & Range("N4").Value
End If
End Sub
Sub Delete_Columns()
Dim v_sheets() As String
Dim ab As Workbook
Dim wb As Workbook
Set ab = ThisWorkbook
Set wb = Workbooks.Open(Sheets(1).Range("B4").Text)
Dim lc As Long
lc = wb.Sheets(1).Range("AZ1").End(xlToLeft).Column
Dim c As Long
v_sheets = Split(ab.Sheets(1).Range("Q4").Text, ",")
Dim intcount As Long
For intcount = LBound(v_sheets) To UBound(v_sheets)
For c = 1 To lc
If wb.Sheets(1).Cells(1, c).Value = v_sheets(intcount) Then
wb.Sheets(1).Columns(c).Delete Shift:=xlToLeft
End If
Next c
Next intcount
wb.Close True
ab.Activate
End Sub
Optimiere es
Ab sofort verarbeitet dieses Skript nur eine Arbeitsmappe. Mit der zuletzt verwendeten Zeilenmethode können Sie das Makro jedoch dazu bringen, mehrere Arbeitsmappen im Stapelmodus zu verarbeiten. Das Skript kann jedoch a nicht öffnen beschädigtes Excel Arbeitsmappe.
Einführung des Autors:
Nick Vipond ist ein Datenrettungsexperte in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich Wortwiederherstellung und Outlook Recovery-Softwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX.