隐藏excel中的列

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

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

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

所以我的想法是，我可以添加一个笔记到每个列标题与文本生产，devise师如果该列是相关的这两个组等等。 然后在vba中遍历所有列并隐藏不相关的列。

隐藏列很容易实现：

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

然后在隐藏工作表或文本文件中指定组名称和用户名，例如：
devise：金，皮特，凯文·
生产：arild，咆哮

任何想法如何最好地做到这一点？

Answer 1

这是一个示例方法。

假设我们保留一个名为Roles的工作表，其中包括个人姓名，angular色以及隐藏每个angular色的列：

以下是一些简单的代码：

1. 得到名字
2. 确定angular色
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 

你会添加一些error handling的代码。 您可能会考虑使用Environ（“username”）等来获取名称

Answer 2

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

它具有一个表格，其中定义了filter，基于列表中可用的列。 它将数据保存在字典中，以便用户将列添加到列表表单中并不重要。 下面是其他可能有用的代码。

 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 

另外我还自动添加button到列表中来激活filter：

 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