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

      

  • 相关阅读:
    μC/OS-III---I笔记5---多值信号量
    μC/OS-III---I笔记4---软件定时器
    μC/OS-III---I笔记3---时间管理
    μC/OS-III---I笔记2---实钟节拍
    μC/OS-III---I笔记1---概述
    Cortex-M系列内核 启动文件分析
    C语言中函数的调用方式
    const,volatile,static,typdef,几个关键字辨析和理解
    java注解细节
    java枚举细节
  • 原文地址:https://www.cnblogs.com/nextseven/p/8437064.html
Copyright © 2011-2022 走看看