我正在尝试为临时用户提供一种编辑宏以在Excel中对数据进行排序的方法。
基本上,我们的数据包含在一个列中,该列包含负责该订单项的部门编号。有些主管可能希望定期查看多个工作单元。
宏工作正常,但是要更改显示的内容,我必须进入并编辑宏中的关联行。
如果功能区上有一个按钮可以打开用户输入字段以更改排序中的部门编号,那将是惊人的。
以下是代码(特别感谢urdearboy的出色工作):
Sub RowScrub()
Dim LRow As Long, I As Long
LRow = Range("B" & Rows.Count).End(xlUp).Row
For I = LRow To 3 Step -1
If Range("B" & I).Value <> 807 And Range("B" & I).Value <> 812 And Range("B" & I).Value <> 820 And Range("B" & I).Value <> 840 And Range("B" & I).Value <> 846 And Range("B" & I).Value <> 849 And Range("B" & I).Value <> 861 And Range("B" & I).Value <> 862 And Range("B" & I).Value <> 864 And Range("B" & I).Value <> 865 And Range("B" & I).Value <> 868 Then
Range("B" & I).EntireRow.Delete
End If
Next I
End Sub
这些3位代码代表我组织中的不同办公室。当前分配给我的办公室是807、820、840、846 ...等。这些数字可以更改和/或可以添加全新的数字。
我知道And Range("B" & I).Value <> 812
行可以根据需要进行编辑或复制。如果要仅在必要时可以通过输入框BUT更改此设置(可能在数周或数月内保持不变),我就喜欢它。
我认为,要执行我需要的操作,将添加一个不同的宏,并将其附加到功能区按钮上,并且仅在需要更改“行擦洗”宏时使用。
我在这里写了一本小说,我什至不知道我是否有意义。请帮忙。
谢谢。
杰里米
答案 0 :(得分:1)
此代码将要求您添加新的工作表,将其命名为“设置”,然后将数字放置在“ A”列中。
Sub RowScrub()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim wsSettings As Worksheet
Set wsSettings = ThisWorkbook.Sheets("Settings")
With wsSettings
j = 1
Do While .Range("A" & j).Value <> ""
dict.Add .Range("A" & j).Value, .Range("A" & j).Value
j = j + 1
Loop
End With
Dim LRow As Long, I As Long
LRow = Range("B" & Rows.Count).End(xlUp).Row
For I = LRow To 3 Step -1
If dict(Range("B" & I).Value) <> Range("B" & I).Value Then
Range("B" & I).EntireRow.Delete
End If
Next I
End Sub
答案 1 :(得分:1)
我知道这对真正改善原始答案并没有多大帮助,但是我认为这值得一提,因为承担创建自己的用户表单的任务可能很困难。我认为仅编辑代码是一个可行的选择,因为您已经说过它可能不会长时间更改,但是通过重新格式化使该任务更易于处理可能是一个“答案”,因此这里是:
Sub RowScrub()
Dim LRow As Long
LRow = Range("B" & Rows.count).End(xlUp).row
Dim i As Long
Dim temp As Long
For i = LRow To 3 Step -1
temp = Range("B" & i).Value2
If temp <> 807 _
And temp <> 812 _
And temp <> 820 _
And temp <> 840 _
And temp <> 846 _
And temp <> 849 _
And temp <> 861 _
And temp <> 862 _
And temp <> 864 _
And temp <> 865 _
And temp <> 868 Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub