在excel中隐藏列

Question

我有点不确定在excel中隐藏列的最佳方法是什么。我有一个息差表，目前A到AL列，但人们不断地添加列的定期。

然后我们有几个用户组，生产，设计师，销售，修改等。

根据用户所在的用户组，我想隐藏与用户无关的列。

因此，我的想法是，我可以在每个列的标题中添加一个注释，如果该列与这两个组相关，则设计器。然后在vba循环中遍历所有列并隐藏不相关的列。

隐藏列很容易实现：

With Range("C:C,F:H,S:AC") .EntireColumn.Hidden = true End With

然后在隐藏的工作表或文本文件中指定组名和用户名，如：

设计:金彼得凯文

生产:arild，咆哮

有什么最好的办法吗？

Answer 1

下面是一个示例方法。

假设我们保存了一个名为Roles的工作表，其中包含了每个角色的名称、角色和要隐藏的列：

​

​

下面是一些简单的代码：

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")等来获取名称。

Answer 2

我从复活节假期回来，感谢你的帮助，我解决了这个问题，

它有一个基于列表表中可用列定义筛选器的工作表。它将数据保存在字典中，这样用户是否将列添加到列表表并不重要。下面是其他人可能会发现有用的代码。

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

​

​

​

​