วิธีการแบทช์ลบคอลัมน์ในสมุดงาน Excel หลายเล่ม

แบ่งปันเลย:

เป็นเรื่องปกติมากที่จะเห็นผู้คนบันทึกข้อมูลที่เป็นความลับในสมุดงาน Excel เมื่อต้องแชร์สมุดงานเหล่านี้กับเพื่อนร่วมงานหรือเพื่อนคนอื่น ๆ การลบด้วยตนเองเป็นทางเลือกเดียวที่มีให้ อย่างไรก็ตามในบทความนี้คุณจะได้เรียนรู้วิธีลบคอลัมน์ที่เป็นความลับหรือคอลัมน์ที่ไม่ต้องการออกจากสมุดงานหลาย ๆ เล่มอย่างรวดเร็ว

ดาวน์โหลดตอนนี้

หากคุณต้องการเริ่มใช้งานซอฟต์แวร์โดยเร็วที่สุด คุณสามารถทำได้ดังนี้:

ดาวน์โหลดซอฟต์แวร์ทันที

มิฉะนั้นหากคุณต้องการ DIY คุณสามารถอ่านเนื้อหาด้านล่าง

เตรียม GUI กันเถอะ

ดังที่แสดงในภาพให้เปลี่ยนชื่อแผ่นงาน 1 เป็น“ ControlPanel” เมื่อใช้รูปทรงเราจะเพิ่มปุ่มบนแผ่นงานนี้เพื่อให้ปรากฏเป็น GUI (ส่วนต่อประสานผู้ใช้แบบกราฟิก) สำหรับเครื่องมือนี้ เราต้องการสามฟิลด์ใน GUI นี้ Field1 คือการแสดงเวิร์กบุ๊กที่ถูกเลือกโดยผู้ใช้ ฟิลด์ 2 คือการแสดงคอลัมน์จากสมุดงานที่เลือกเป็นแบบเลื่อนลง ฟิลด์ 3 คือรายการคอลัมน์ที่ควรลบออกจากเวิร์กบุ๊กเตรียม GUI

มันทำงานอย่างไร?

รหัส VBAขั้นตอน p_fpick จะอนุญาตให้ผู้ใช้เรียกดูและเลือกไฟล์ Excel ทันทีที่เลือกไฟล์ Excel สคริปต์จะอ่านชื่อคอลัมน์จาก Sheet1 และชื่อเหล่านี้จะแสดงเป็นแบบเลื่อนลง ขั้นตอน“ Add_Column” จะอนุญาตให้ผู้ใช้เพิ่มชื่อคอลัมน์ที่เลือกจากเมนูแบบเลื่อนลงเพื่อเพิ่มลงในรายการคอลัมน์ที่ต้องลบ ขั้นตอนสุดท้าย“ Delete_Columns” จะเปิดเวิร์กบุ๊กที่อยู่ในฟิลด์“ เลือกเวิร์กบุ๊ก” และจะลบคอลัมน์ที่เลือกทั้งหมด หลังจากลบแล้วสมุดงานจะถูกบันทึกและปิด

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

ปรับแต่งมัน

ณ ตอนนี้สคริปต์นี้จัดการสมุดงานเดียวเท่านั้น แต่เมื่อใช้วิธีการแถวที่ใช้ล่าสุดคุณสามารถทำให้มาโครจัดการสมุดงานหลาย ๆ เล่มในโหมดแบตช์ได้ อย่างไรก็ตามสคริปต์ไม่สามารถเปิดไฟล์ Excel เสียหาย สมุดงาน

บทนำผู้เขียน:

Nick Vipond เป็นผู้เชี่ยวชาญด้านการกู้คืนข้อมูลใน DataNumen, Inc. ซึ่งเป็นผู้นำระดับโลกด้านเทคโนโลยีการกู้คืนข้อมูล ได้แก่ การกู้คืนคำ และผลิตภัณฑ์ซอฟต์แวร์กู้คืน Outlook ดูข้อมูลเพิ่มเติมได้ที่ wwwdatanumenด้วย..

แบ่งปันเลย:

ความเห็นถูกปิด