Excel 将输出存储在临时表中以进行排序_Excel_Vba

Excel 将输出存储在临时表中以进行排序

excel vba

Excel 将输出存储在临时表中以进行排序,excel,vba,Excel,Vba,从这个问题开始，（谢谢Siddharth！）我想编辑代码，以按最长天数到最短天数的顺序列出任务。与Siddharth进行了简短的评论聊天，他建议最好的方法是在删除临时表之前创建一个包含数据的临时表，按到达的数据排序并创建消息框。你知道从哪里开始吗？我可以将msg字符串导出到一个新的工作表中吗？或者它是否需要是一个变量，而不是t来存储在工作表中 Option Explicit Sub Notify() Dim WS1 As Worksheet Dim Chk As Range,

从这个问题开始，（谢谢Siddharth！）我想编辑代码，以按最长天数到最短天数的顺序列出任务。与Siddharth进行了简短的评论聊天，他建议最好的方法是在删除临时表之前创建一个包含数据的临时表，按到达的数据排序并创建消息框。你知道从哪里开始吗？我可以将msg字符串导出到一个新的工作表中吗？或者它是否需要是一个变量，而不是t来存储在工作表中

Option Explicit

Sub Notify()
    Dim WS1 As Worksheet
    Dim Chk As Range, FltrdRange As Range, aCell As Range
    Dim ChkLRow As Long
    Dim msg As String
On Error GoTo WhatWentWrong

Application.ScreenUpdating = False

Set WS1 = Sheets("Ongoing")

With WS1
    ChkLRow = .Range("C" & Rows.Count).End(xlUp).Row

    '~~> Set your relevant range here
    Set Chk = .Range("A1:K" & ChkLRow)

    '~~> Remove any filters
    ActiveSheet.AutoFilterMode = False

    With Chk
        '~~> Filter,
        .AutoFilter Field:=3, Criteria1:="NO"
        '~~> Offset(to exclude headers)
        Set FltrdRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
        '~~> Remove any filters
        ActiveSheet.AutoFilterMode = False

        For Each aCell In FltrdRange
            If aCell.Column = 8 And _
            Len(Trim(.Range("B" & aCell.Row).Value)) <> 0 And _
            Len(Trim(aCell.Value)) <> 0 Then
                msg = msg & vbNewLine & _
                      "Request for contractor code " & .Range("B" & aCell.Row).Value & _
                      " dispensing month " & .Range("A" & aCell.Row).Value & _
                      " has been in the cupboard for " & _
                      DateDiff("d", aCell.Value, Date) & " days."
            End If
        Next
    End With
End With

'~~> Show message
MsgBox msg
Reenter:
Application.ScreenUpdating = True
Exit Sub
WhatWentWrong:
MsgBox Err.Description
Resume Reenter
End Sub

选项显式
副通知（）
将WS1设置为工作表
调光开关为量程，外差开关为量程，调光开关为量程
长得一样暗
作为字符串的Dim msg
关于错误转到什么错误
Application.ScreenUpdating=False
设置WS1=工作表（“正在进行”）
使用WS1
ChkLRow=.Range（“C”和Rows.Count）.End（xlUp）.Row
“~~>在此处设置相关范围
设置Chk=.Range（“A1:K”和ChkLRow）
“~~>删除任何筛选器
ActiveSheet.AutoFilterMode=False
与Chk
“~~>过滤器，
.自动筛选字段：=3，标准1:=否
“~~>偏移量（用于排除标题）
设置FltrdRange=.Offset（1,0）.SpecialCells（xlCellTypeVisible）
“~~>删除任何筛选器
ActiveSheet.AutoFilterMode=False
对于外教中的每个aCell
如果aCell.Column=8和_
Len（修剪（.Range（“B”）和aCell.Row.Value））0和_
Len（Trim（aCell.Value））0然后
msg=msg&vbNewLine&_
“承包商代码请求”和范围（“B”和aCell.Row）.值和_
“分配月”和范围（“A”和A行）。值和_
“已经在柜子里呆了”和_
DateDiff（“d”，aCell.Value，Date）和“天”
如果结束
下一个
以
以
“~~>显示消息
MsgBox味精
重新输入：
Application.ScreenUpdating=True
出口接头
怎么了
MsgBox错误说明
重新进入
端接头

这就是您要尝试的吗

Option Explicit

Sub Notify()
    Dim WS1 As Worksheet, TmpSht As Worksheet
    Dim Chk As Range, FltrdRange As Range, aCell As Range
    Dim ChkLRow As Long, TSLastRow As Long, i As Long
    Dim msg As String

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Alistair_Weir").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    On Error GoTo WhatWentWrong

    Application.ScreenUpdating = False

    Set WS1 = Sheets("Ongoing")

    With WS1
        ChkLRow = .Range("C" & Rows.Count).End(xlUp).Row

        '~~> Set your relevant range here
        Set Chk = .Range("A1:K" & ChkLRow)

        '~~> Remove any filters
        ActiveSheet.AutoFilterMode = False

        With Chk
            '~~> Filter,
            .AutoFilter Field:=3, Criteria1:="NO"
            '~~> Offset(to exclude headers)
            Set FltrdRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
            '~~> Remove any filters
            ActiveSheet.AutoFilterMode = False

            '~~> Add Temp Sheet
            Set TmpSht = Sheets.Add
            ActiveSheet.Name = "Alistair_Weir"

            '~~> Copy required rows to temp sheet
            TSLastRow = 1
            For Each aCell In FltrdRange
                If aCell.Column = 8 And _
                Len(Trim(.Range("B" & aCell.Row).Value)) <> 0 And _
                Len(Trim(aCell.Value)) <> 0 Then
                    WS1.Rows(aCell.Row).Copy TmpSht.Rows(TSLastRow)
                    TSLastRow = TSLastRow + 1
                End If
            Next
        End With
    End With

    With TmpSht
        '~~> Sort Data
        .Columns("A:H").Sort Key1:=.Range("H1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        '~~> Create the message
        For i = 1 To TSLastRow - 1

            msg = msg & vbNewLine & _
                  "Request for contractor code " & .Range("B" & i).Value & _
                  " dispensing month " & .Range("A" & i).Value & _
                  " has been in the cupboard for " & _
                  DateDiff("d", .Range("H" & i).Value, Date) & " days."
        Next

        '~~> Delete the temp sheet
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With

    '~~> Show message
    MsgBox msg
Reenter:
    Application.ScreenUpdating = True
    Exit Sub
WhatWentWrong:
    MsgBox Err.Description
    Resume Reenter
End Sub

选项显式
副通知（）
尺寸WS1作为工作表，TmpSht作为工作表
调光开关为量程，外差开关为量程，调光开关为量程
暗淡的ChkLRow一样长，TSLastRow一样长，我一样长
作为字符串的Dim msg
出错时继续下一步
Application.DisplayAlerts=False
表格（“Alistair_Weir”）。删除
Application.DisplayAlerts=True
错误转到0
关于错误转到什么错误
Application.ScreenUpdating=False
设置WS1=工作表（“正在进行”）
使用WS1
ChkLRow=.Range（“C”和Rows.Count）.End（xlUp）.Row
“~~>在此处设置相关范围
设置Chk=.Range（“A1:K”和ChkLRow）
“~~>删除任何筛选器
ActiveSheet.AutoFilterMode=False
与Chk
“~~>过滤器，
.自动筛选字段：=3，标准1:=否
“~~>偏移量（用于排除标题）
设置FltrdRange=.Offset（1,0）.SpecialCells（xlCellTypeVisible）
“~~>删除任何筛选器
ActiveSheet.AutoFilterMode=False
“~~>添加临时工作表
设置TmpSht=图纸。添加
ActiveSheet.Name=“Alistair\u Weir”
“~~>将所需行复制到临时工作表
TSLastRow=1
对于外教中的每个aCell
如果aCell.Column=8和_
Len（修剪（.Range（“B”）和aCell.Row.Value））0和_
Len（Trim（aCell.Value））0然后
WS1.Rows（aCell.Row）.复制TmpSht.Rows（TSLastRow）
TSLastRow=TSLastRow+1
如果结束
下一个
以
以
使用TmpSht
“~~>对数据进行排序
.Columns（“A:H”）.Sort Key1:=.Range（“H1”），Order1:=xlAscending，Header:=xlGuess_
OrderCustom:=1，MatchCase:=False，方向：=xlTopToBottom_
DataOption1:=xlSortNormal
“~~>创建消息
对于i=1到t最后一行-1
msg=msg&vbNewLine&_
“承包商代码请求”和范围（“B”和i）.值和_
“分配月”和范围（“A”和i）.值和_
“已经在柜子里呆了”和_
DateDiff（“d”和.Range（“H”和i）.值，日期）和“天”
下一个
“~~>删除临时工作表
Application.DisplayAlerts=False
.删除
Application.DisplayAlerts=True
以
“~~>显示消息
MsgBox味精
重新输入：
Application.ScreenUpdating=True
出口接头
怎么了
MsgBox错误说明
重新进入
端接头

看看这里，它几乎准确地描述了您试图实现的目标：创建一个新工作表，对新工作表进行排序，将排序后的值加载回您可以使用的数组中，然后删除临时工作表。+1但与其构建一个每个循环都很慢的临时工作表，不如复制整个工作表，过滤/排序，构建消息框，最后删除重复的表单。点击Siddharth:）再次感谢。