ซ่อนคอลัมน์ใน Excel

นี่คือตัวอย่างวิธีการ

สมมติว่าเราเก็บแผ่นงานชื่อ บทบาท พร้อมด้วยชื่อบุคคล บทบาทที่พวกเขาเล่น และคอลัมน์ที่จะซ่อนสำหรับแต่ละบทบาท:

ต่อไปนี้เป็นโค้ดง่ายๆ สำหรับ:

1. รับชื่อ
2. กำหนดบทบาท
3. ซ่อนคอลัมน์ในแผ่นงาน Sheet1

Sub ColumnHider()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim uName As String, r1 As Range, r2 As Range, HideC As String
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Roles")

    uName = Application.InputBox(Prompt:="Enter your name", Type:=2)
    Set r1 = s2.Range("A:A").Find(What:=uName, After:=s2.Range("A1"))
    role = r1.Offset(0, 1).Value
    Set r2 = s2.Range("D:D").Find(What:=role, After:=s2.Range("D1"))
    HideC = r2.Offset(0, 1).Value
    s1.Cells.EntireColumn.Hidden = False
    s1.Range(HideC).EntireColumn.Hidden = True
End Sub

คุณจะเพิ่มการจัดการข้อผิดพลาดบางอย่างให้กับโค้ด คุณอาจพิจารณารับชื่อโดยใช้ Environ("username") เป็นต้น

ฉันกลับมาจากวันหยุดอีสเตอร์ และขอบคุณสำหรับความช่วยเหลือของคุณ ฉันจึงสามารถแก้ไขปัญหาได้

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

Sub filterCreation()

Dim lColumn As Long
rowHeader = 2 ' HEader row in list sheet
rowHeader2 = 1 'header row in filter sheet

Set ws = ThisWorkbook.Sheets("List")
Set ws2 = ThisWorkbook.Sheets("Filter")
lColumn = ws.Cells(rowHeader, Columns.Count).End(xlToLeft).column
Set columnHeader = CreateObject("Scripting.Dictionary")
Set filterDict = CreateObject("Scripting.Dictionary")
Dim temp() As Variant

lRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

For i = rowHeader2 To lRow
lcolumn2 = ws2.Cells(i, Columns.Count).End(xlToLeft).column
If lcolumn2 > 1 Then
    ReDim temp(lcolumn2 - 2)

    For j = 2 To lcolumn2
        temp(j - 2) = ws2.Cells(i, j)
    Next j

    Else
        temp = Array(Empty)
    End If

    filterDict.Add CStr(ws2.Cells(i, 1).Value), temp

 Next i


tempCol = ws2.Cells(1, Columns.Count).End(xlToLeft).column
ws2.Range(ws2.Cells(rowHeader2 + 1, 1), ws2.Cells(lRow, tempCol)).Clear


'Refill the sheet
For i = 1 To lColumn
'columnHeader.Add ws.Cells(rowHeader, i), ""

If filterDict.Exists(CStr(ws.Cells(rowHeader, i).Value)) Then
    b = filterDict.Item(CStr(ws.Cells(rowHeader, i).Value))

    For k = LBound(b) To UBound(b)
        ws2.Cells(rowHeader2 + i, k + 2).Value = b(k)
    Next k
End If

'column header to excel sheet
ws2.Cells(rowHeader2 + i, 1).Value = ws.Cells(rowHeader, i).Value

Next i



'Set columnHeader = Nothing
Set filterDict = Nothing

End Sub

นอกจากนี้ ฉันยังเพิ่มปุ่มลงในแผ่นรายการโดยอัตโนมัติเพื่อเปิดใช้งานตัวกรอง:

Sub CreateButtons()
'On Error Resume Next

Set ws2 = ThisWorkbook.Sheets("Filter")
Set ws1 = ThisWorkbook.Sheets("List")

For Each wShape In ws1.Shapes
    wShape.Delete
Next wShape

rowHeader2 = 1
lcolumn2 = ws2.Cells(rowHeader2, Columns.Count).End(xlToLeft).column

tempName = "All"
ws1.Buttons.Add(20, 20, 81, 36).Name = tempName
ws1.Shapes(tempName).OnAction = "Unhide_All_Columns"
ws1.Shapes(tempName).Placement = xlFreeFloating
ws1.Shapes(tempName).Select
Selection.Characters.Text = "All"


tempName = "ShowGUI"
ws1.Buttons.Add(120, 20, 81, 36).Name = tempName
ws1.Shapes(tempName).OnAction = "loadGUI"
ws1.Shapes(tempName).Placement = xlFreeFloating
ws1.Shapes(tempName).Select
Selection.Characters.Text = "Show GUI"


For i = 2 To lcolumn2
    tempName = CStr(ws2.Cells(rowHeader2, i).Value)
    ws1.Buttons.Add(15 + i * 100, 20, 81, 36).Name = tempName
    ws1.Shapes(tempName).OnAction = "Tester"
    ws1.Shapes(tempName).Placement = xlFreeFloating
    ws1.Shapes(tempName).Select
    Selection.Characters.Text = tempName
    'ws2.Shapes(tempName).Characters.Text = CStr(ws2.Cells(rowHeader2, i).Value)
Next i
End Sub