Nagyon gyakori, hogy az emberek bizalmas adatokat mentenek el Excel-munkafüzetekbe. Ha ezeket a munkafüzeteket meg kell osztani más kollégákkal vagy barátokkal, a kézi törlés az egyetlen elérhető lehetőség. Ebből a cikkből azonban megtudhatja, hogyan lehet gyorsan törölni több munkafüzetből a bizalmas oszlopokat vagy a nem kívánt oszlopokat.
Töltse le most
Ha a lehető leghamarabb el szeretné kezdeni a szoftver használatát, akkor a következőket teheti:
Ellenkező esetben, ha barkácsolni szeretne, az alábbiakban olvashatja a tartalmat.
Készítsük el a GUI-t
A képen látható módon nevezze át az 1. lapot „Vezérlőpult” névre. Alakzatok használatával gombokat adunk hozzá ehhez a laphoz, hogy az eszköz grafikus felhasználói felületeként jelenjen meg. Három mezőre van szükségünk ezen a grafikus felületen. Az 1. mező a felhasználó által kiválasztott munkafüzet megjelenítésére szolgál. A 2. mező a kiválasztott munkafüzet oszlopait legördülő menüként jeleníti meg. A 3. mező azoknak az oszlopoknak a listája, amelyeket el kell távolítani a munkafüzetből.
Hogyan működik?
A p_fpick eljárás lehetővé teszi a felhasználó számára az Excel-fájlok böngészését és kiválasztását. Amint kiválaszt egy Excel-fájlt, a szkript beolvassa az oszlopneveket a Sheet1-ből, és ezek a nevek legördülő menüben jelennek meg. Az „Add_Column” eljárás lehetővé teszi a felhasználó számára, hogy hozzáadja a kiválasztott oszlop nevét a legördülő menüből, hogy hozzáadja a törölni kívánt oszlopok listájához. Az utolsó „Oszlopok törlése” eljárás megnyitja a „Select the workbook” mezőben felsorolt munkafüzetet, és eltávolítja az összes kijelölt oszlopot. A törlés után a munkafüzet mentésre kerül és bezárásra kerül.
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
Csípje meg
Jelenleg ez a szkript csak egy munkafüzetet kezel. Az utoljára használt sormódszerrel azonban a makró több munkafüzetet kötegelt módban kezelhet. A szkript azonban nem tudja megnyitni a korrupt Excel munkafüzet.
Szerző Bevezetés:
Nick Vipond adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve szó helyreállítása és az Outlook helyreállítási szoftvertermékei. További információért látogasson el www.datanumen.com.