如何依据条件提取数据并重新排列，老师们帮帮忙

wyf198251

依据sheet1表里的阀位允许波幅值（A3）在sheet2表里提取B列位号结尾是“MV”且G列波幅大于A3的A、B、F、G列数据和依据sheet1表里的PV值允许波幅值（A5）在sheet2表里提取B列位号结尾是“PV”且G列波幅大于A5的A、B、F、G列数据，二者提取后放到sheet1的B、C、D、E列对应的名称、位号、最大跨度、波幅里，并进行排列，先位号结尾是“MV”的根据波幅（这个波幅是数值）从大到小排，接着位号结尾是“PV”的根据波幅（这个波幅是百分比）从大到小排，sheet2表里的数据在点击“计算”按钮后会更新，更新完后sheet1里提取过来的也要更新。老师们帮帮忙，感激不尽！

hzqhxy

看是否为你要的效果

准提部林

Sub TEST_A1()
Dim Arr, Brr(2), N&(2), Crr, T$, V(2), i&, j%, k%
Sheet1.UsedRange.Offset(1, 1).Clear
V(1) = Val([a3]):  V(2) = Val([a5])
Arr = Range(Sheet2.[A1], Sheet2.UsedRange)
For i = 3 To UBound(Arr)
    T = Right(Arr(i, 2), 2)
    k = Switch(T = "MV", 1, T = "PV", 2, T = T, 0)
    If k = 0 Then GoTo 101
    If Val(Arr(i, 7)) <= V(k) Then GoTo 101
    Crr = Brr(k)
    If Not IsArray(Crr) Then ReDim Crr(1 To UBound(Arr), 1 To 4)
    N(k) = N(k) + 1
    For j = 1 To 4
        Crr(N(k), j) = Arr(i, Mid(1267, j, 1))
    Next j
    Brr(k) = Crr
101: Next i
For k = 1 To 2
    If N(k) = 0 Then GoTo 102
    With Sheet1.[B65536].End(xlUp)(2).Resize(N(k), 4)
         .Value = Brr(k)
         .Columns(3).NumberFormatLocal = "0.0"
         .Columns(4).NumberFormatLocal = IIf(k = 2, "0.0%", "0.0")
         .Sort Key1:=.Item(4), Order1:=xlDescending, Header:=xlNo
    End With
102: Next k
End Sub

Xl0000265.rar (17.89 KB, 下载次数: 8)

2021-3-21 11:14 上传

点击文件名下载附件

wyf198251

准提部林 发表于 2021-3-21 11:15
Sub TEST_A1()
Dim Arr, Brr(2), N&(2), Crr, T$, V(2), i&, j%, k%
Sheet1.UsedRange.Offset(1, 1).Clea ...

非常感谢！明天我测试一下

wyf198251

准提部林 发表于 2021-3-21 11:15
Sub TEST_A1()
Dim Arr, Brr(2), N&(2), Crr, T$, V(2), i&, j%, k%
Sheet1.UsedRange.Offset(1, 1).Clea ...

你好！老师，你的代码试了一下可用，但现在位号里的“MV”或“PV”不一定是最后两个位，我已自行加以区分，并在条件格式里设置好规则，满足我的规则的数填充色会变红，老师能否重新帮忙写下代码，就是在后面几个工作表里G列填充色变红的数及对应的名称、位号、最大跨度提取到汇总表的B、C、D、E列，并在F列显示对应数据取自哪张工作表（重整、芳烃、常减压、PSA、加氢）。若汇总表B2:F500（更多也行）区域有提取到数据就播放音频，直到按下“消音”控件后停止播放，音频文件在附件里，音频希望能嵌入到excel里，不需打包携带，麻烦老师了，谢谢！

准提部林

wyf198251 发表于 2021-3-22 00:15
你好！老师，你的代码试了一下可用，但现在位号里的“MV”或“PV”不一定是最后两个位，我已自行加以区分 ...

1) 格式化條件的顏色判斷, 我的版本做不了
2) EXCEL是工作用, 不是娛樂用, 加音樂還要內嵌???

放棄了~~

wyf198251

准提部林 发表于 2021-3-22 11:39
1) 格式化條件的顏色判斷, 我的版本做不了
2) EXCEL是工作用, 不是娛樂用, 加音樂還要內嵌???

是为了工作，我自行做了间隔一定时间自动计算，文件一直开着，一旦有提取到超指标的可以有提示音提醒我，不用一直盯看

wyf198251

准提部林 发表于 2021-3-22 11:39
1) 格式化條件的顏色判斷, 我的版本做不了
2) EXCEL是工作用, 不是娛樂用, 加音樂還要內嵌???

你好！老师，我把条件格式通过辅列I列来实现，现在就是把后面几个工作表I列单元格是“Y”的对应行的A、B、F、G、H数据提取到汇总表的B、C、D、E、F列（I列单元格自身数值不提取），汇总表里无需额外排序。麻烦老师能否再帮忙写下代码？至于提取到内容播放提示音，能实现最好，不好弄就暂时不弄了，谢谢！

准提部林

wyf198251 发表于 2021-3-22 14:35
你好！老师，我把条件格式通过辅列I列来实现，现在就是把后面几个工作表I列单元格是“Y”的对应行的A、B ...

Sub TEST_A02()
Dim Arr, Brr, X%, i&, j%, N&
Sheet1.UsedRange.Offset(1, 1).Clear
ReDim Brr(1 To 20000, 1 To 5)
For X = 2 To Sheets.Count
    Arr = Range(Sheets(X).[A1:i1], Sheets(X).UsedRange)
    For i = 2 To UBound(Arr)
        If Arr(i, 9) = "Y" Then
           N = N + 1: Brr(N, 5) = Sheets(X).Name
           For j = 1 To 4
               Brr(N, j) = Arr(i, Mid(1267, j, 1))
           Next j
        End If
    Next i
Next
If N > 0 Then Sheet1.[b2].Resize(N, 5) = Brr
End Sub

wyf198251

准提部林 发表于 2021-3-22 15:57
Sub TEST_A02()
Dim Arr, Brr, X%, i&, j%, N&
Sheet1.UsedRange.Offset(1, 1).Clear

非常感谢！！