根据单元格内容在 Excel 中选择单元格

Question

我正在使用 Excel 尝试在 VB 中为应用程序编写宏，并且可以使用您的帮助。

我的目标：

将 1000 条记录从 Toad 导出到 Excel，然后运行一个宏，该宏将根据单元格内容将某些记录放置在某些工作表上。

我的数据示例：

（对不起，我会内联发布图片，但我没有足够的声誉）

数据说明：

权限 - 用户的不同角色
User_name - 每个用户的用户名
sort_name - 每个用户的last_name，first_name

我想让宏做什么：

在权限列中，选择所有具有相同权限的记录及其对应的详细信息，将它们剪切并粘贴到新工作表上。在数据末尾重复此操作以获得特权。

示例：

选择所有管理行以及 user_name 和 sort_name。剪切选定的行，粘贴到 sheet2。
选择所有主持人行以及 user_name 和 sort_name。剪切选定的行，粘贴到 sheet3。
选择所有 GeneralUser 行以及 user_name 和 sort_name。剪切选定的行，粘贴在 sheet4 上。

其他信息：

在我的实际数据中，有数千行具有大约 60 种不同的权限。因此，当我在真实数据上运行此程序时，将生成一个包含 60 个不同工作表的工作簿。

特权将按顺序排列。所有管理员将在一起。单元格 A2-A9 不会有 10 个管理员，而 A67-A100 不会有更多管理员。它们是连续的。

其中包含原始数据的第一张表将在此过程结束时被删除，因此格式无关紧要。

我试过了：

Sub Test()
'
' Test Macro
'

'
    Range("A2:C9").Select
    Selection.Cut
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("A10:C14").Select
    Selection.Cut
    Sheets("Sheet3").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("A15:C25").Select
    Selection.Cut
    Sheets("Sheet3").Select
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
End Sub

但这会选择通用单元格，而不是基于所写文本的单元格。这意味着它不是为可变长度编码的。

非常感谢任何帮助！

Answer 1

试试这个，下面假设：工作表不是为 privs 创建的，数据按 A 列排序，活动表是包含您的数据的工作表

Values_To_Find 需要更改为您拥有的所有权限，它只是一个逗号分隔列表

它不会删除原始工作表

Sub t()
Dim start_rng As Range

Values_To_Find = "Admin,Moderator,GeneralUser"
sp = Split(Values_To_Find, ",")

With ActiveSheet
    For i = 0 To UBound(sp)
        Found = 0
        Set start_rng = .Range("A1")
        For Each cell In .Range("A2:" & .Range("A2").End(xlDown).Offset(1, 0).Address)
            If Found = 1 And cell.Value <> sp(i) Then 'find end
                Set end_rng = cell
                Exit For
            End If
            If cell.Value = sp(i) And start_rng.Address = "$A$1" Then 'find start
                Set start_rng = cell
                Found = 1
            End If
        Next

        Set ws = Sheets.Add
        ws.Name = sp(i)
        .Range(start_rng.Address & ":" & Range(end_rng.Address).Offset(-1, 3).Address).Copy
        ws.Range("A1").PasteSpecial
    Next
End With

End Sub