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

      

  • 相关阅读:
    windows环境下的python2.6 安装pydelicious API的正确方法与步骤
    2、提供推荐
    python的os.path.join()
    ompl_interface/OMPLPlanner
    ros moveit 安装
    ipv6 duplicate address detected
    python版本原因导致不能安装和卸载软件
    RoboWare Viewer安装可能出现的问题
    npm install 时卡在了node-gyp rebuild
    npm install 出错
  • 原文地址:https://www.cnblogs.com/nextseven/p/8437064.html
Copyright © 2011-2022 走看看