zoukankan      html  css  js  c++  java
  • 过滤问题




    Sub FiterQuestion() Dim Wb As Workbook Dim Sht As Worksheet Dim dHow As Object Dim dWhat As Object Dim HasHow As Boolean Dim HasWhat As Boolean Dim Dic As Object Dim Index As Long Dim Ar() As String ReDim Ar(1 To 3, 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") Set dHow = CreateObject("Scripting.Dictionary") Set dWhat = CreateObject("Scripting.Dictionary") Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets("Filter") With Sht endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row For i = 2 To endrow Key = .Cells(i, 1).Text dHow(Key) = "" Next i endrow = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row For i = 2 To endrow Key = .Cells(i, 2).Text dWhat(Key) = "" Next i End With Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets("Question") With Sht endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row Set Rng = .Range("A2:C" & endrow) Arr = Rng.Value Index = 0 For i = LBound(Arr) To UBound(Arr) HasHow = False HasWhat = False Ques = CStr(Arr(i, 3)) For Each OneHow In dHow.Keys If InStr(Ques, OneHow) > 0 Then HasHow = True Exit For End If Next OneHow For Each OneWhat In dWhat.Keys If InStr(Right(Ques, 6), OneWhat) > 0 Then HasWhat = True Exit For End If Next OneWhat If HasHow And HasWhat Then Index = Index + 1 ReDim Preserve Ar(1 To 3, 1 To Index) For j = 1 To 3 Ar(j, Index) = Arr(i, j) Next j End If Next i End With Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets("After") With Sht .UsedRange.Offset(1, 0).ClearContents Set Rng = .Range("A2") Set Rng = Rng.Resize(Index, 3) Rng.Value = Application.WorksheetFunction.Transpose(Ar) End With Set Dic = Nothing Set Wb = Nothing Set Sht = Nothing Set Rng = Nothing Set dWhat = Nothing Set dHow = Nothing End Sub

      

  • 相关阅读:
    Android Studio 快捷键
    维基百科地址(应该是吧)
    Freeswitch常見問題解決辦法
    配置SIP网关拨打外部电话
    Freeswitch连接SIP软电话
    CentOS6.5安装freeswitch以及啟動
    hdu 4292: Food(Dinic + 链式前向星)
    hdu 2709:Sumsets(递推)
    hdu 2577:How to Type(动态规划)
    hdu 2955:Robberies(01背包)
  • 原文地址:https://www.cnblogs.com/nextseven/p/8437064.html
Copyright © 2011-2022 走看看