Question

求帮忙写一段在EXCEL中使用VBA能够筛选数据并处理计算的代码

一、删除B列中包含“阿富汗”所在行的所有数据二、先从第一行开始判断1、如果B列所在行包含“吉林、黑龙江、北京”，继续判断（1）C列中所在行等于“符合”，E列所在行计算结果=（D对应行数+1）的对应数值+（D对应行数+2）的对应数值。F列使用与E列相同计算公式。（2）C列中所在行等于“不符合”，E列所在行计算结果=（D对应行数+2）的对应数值+（D对应行数+3）的对应数值。F列使用与E列相同计算公式。（3）C列中所在行等于“低于”，E列所在行计算结果=（D对应行数+3）的对应数值+（D对应行数+1）的对应数值。F列使用与E列相同计算公式。2、如果B列所在行不包含“吉林、黑龙江、北京”，继续判断（1）C列中所在行等于“低于”，E列所在行计算结果=（D对应行数+2）的对应数值+（D对应行数+2）的对应数值。F列使用与E列相同计算公式。F列使用与E列相同计算公式。（2）C列中所在行不等于“不符合、低于、符合”，E列所在行计算结果=（D对应行数+2）的对应数值+（D对应行数+1）的对应数值。F列使用与E列相同计算公式。F列使用与E列相同计算公式。三、执行以上判断并+1行进行循环，直到判断B列所在行数据为空。弹出“计算结束”文本提示框。大概是下面这样的逻辑，我不会写代码T_TSub 123123123()Dim i, j，k As Integer k = Sheets(1).[A65535].End(xlUp).Row//获取非空行数Sub delete()//如果j行3列中包含阿富汗，则删除该行 Dim rng As Range Application.ScreenUpdating = False For j = 2 To Cells(Rows.Count, 3).End(3).Row If InStr("阿富汗", Cells(j, 3)) <> 0 Then If rng Is Nothing Then Set rng = Cells(j, 3) Else Set rng = Union(rng, Cells(j, 3)) End If End If Next j If Not rng Is Nothing Then rng.EntireRow.delete Application.ScreenUpdating = TrueEnd Sub if (i,5)=吉林or黑龙江or北京//如果i行5列中包含吉林或者黑龙江或者北京其中之一Select Case Range(i, 3).Value//判断i行3列中数据Case Is = 符合//如果i行3列值为“符合” Range("i.7") = (i-2.7) - (i-5.7)//i行7列执行计算=（i-2行7列）-（i-5行7列） Range("i.8") = (i.7) - (i - 5.7)Case Is = 不符合 Range("i.7") = (i - 2.7) - (i - 6.7) Range("i.8") = (i.7) + (i - 3.7)-(i-6.8)Case Is = 低于 Range("i.7") = (i - 2.7) - (i - 6.7) Range("i.8") = (i.7) + (i - 3.7)-(i-6.8) End Ifif (i,5)<>吉林or黑龙江or北京Select Case Range(i, 3).ValueCase Is = 符合Range("i.7") = (i - 2.7) - (i - 5.7)Range("i.8") = (i.7) + (i - 3.7)-(i-5.8)Case Else //如果i行7列值不是“符合”的话Range("i.7") = (i - 2.7) - (i - 6.7) Range("i.8") = (i.7) + (i - 3.7)-(i-6.8)end ifi=i+1 //逐行按以上条什执行以上计算loopif i=k //当执行到空行后停止循环exit subEnd Sub





Answer 1

Sub cdsr()
Dim arr, brr(1 To 10000, 1 To 4), i&, j&
arr = Sheet1.[a1].CurrentRegion
For i = 2 To UBound(arr)
For j = 3 To UBound(arr, 2)
If arr(i, j) >= 90 Then
k = k + 1
brr(k, 1) = arr(i, 1)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(1, j)
brr(k, 4) = arr(i, j)
End If
Next
Next
[h2:k10000] = ""
[h2].Resize(k, 4) = brr
End Sub