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

      

  • 相关阅读:
    python 魔法方法
    wfst的compose算法
    文法和语言,理解克林闭包
    openfst常用命令
    Longest Substring Without Repeating Characters
    xgboost 实践
    决策树学习
    OPC UA的监控项、订阅、和通知
    限流及常用算法
    本体论与OWL
  • 原文地址:https://www.cnblogs.com/nextseven/p/8437064.html
Copyright © 2011-2022 走看看