Je velmi běžné vidět lidi ukládající důvěrná data v sešitech aplikace Excel. Pokud je třeba tyto sešity sdílet s ostatními kolegy nebo přáteli, je jedinou dostupnou možností ruční mazání. V tomto článku se však naučíte, jak rychle odstranit důvěrné sloupce nebo nežádoucí sloupce z více sešitů.
Stáhnout nyní
Pokud chcete software začít používat co nejdříve, můžete:
Jinak si můžete přečíst obsah níže, pokud si chcete udělat kutilství.
Připravíme GUI
Jak je znázorněno na obrázku, přejmenujte list 1 na „ControlPanel“. Pomocí tvarů bychom na tento list přidali tlačítka, aby se pro tento nástroj zobrazovala jako GUI (grafické uživatelské rozhraní). Na tomto grafickém uživatelském rozhraní potřebujeme tři pole. Pole 1 má zobrazit sešit vybraný uživatelem. Pole 2 má zobrazit sloupce z vybraného sešitu jako rozevírací nabídku. Pole 3 je seznam sloupců, které by měly být ze sešitu odebrány.
Jak to funguje?
Postup p_fpick by uživateli umožnil procházet a vybírat soubory Excel. Jakmile je vybrán soubor aplikace Excel, skript načte názvy sloupců z Listu1 a tyto názvy se zobrazí jako rozevírací seznam. Postup „Add_Column“ umožní uživateli přidat název vybraného sloupce z rozevíracího seznamu a přidat jej do seznamu sloupců, které je třeba odstranit. Konečný postup „Delete_Columns“ by otevřel sešit, který byl uveden v poli „Select the workbook“, a odstranil by všechny vybrané sloupce. Po odstranění by sešit uložil a zavřel.
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
Vylepšete to
Od této chvíle tento skript zpracovává pouze jeden sešit. Ale pomocí metody posledního použitého řádku můžete makro zpracovat několik sešitů v dávkovém režimu. Skript však nemůže otevřít a poškozený Excel pracovní sešit.
Úvod autora:
Nick Vipond je odborníkem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně zotavení slov a softwarové produkty pro obnovení aplikace Outlook. Pro více informací navštivte www.datanumen.com.