zoukankan      html  css  js  c++  java
  • 创建小专题

    Sub PartFiterQuestion()
    
    Application.DisplayAlerts = False
    
        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("创建小专题")
        With Sht
            PartName = .Range("C2").Text
            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
        
    On Error Resume Next
          Wb.Worksheets(PartName).Delete
    On Error GoTo 0
    
        
        
      
        Set NewSht = Wb.Worksheets.Add(After:=Wb.Worksheets(Wb.Worksheets.Count))
        NewSht.Name = PartName
        
        'Set NewSht = Wb.Worksheets("PartAfter")
        With NewSht
            .Range("A1:C1").Value = Array("试卷", "URL", "问题")
            
            Set Rng = .Range("A2")
            Set Rng = Rng.Resize(Index, 3)
            Rng.Value = Application.WorksheetFunction.Transpose(Ar)
            .UsedRange.Columns.AutoFit
            
        End With
        
        
        Set Dic = Nothing
        Set Wb = Nothing
        Set Sht = Nothing
        Set Rng = Nothing
        Set dWhat = Nothing
        Set dHow = Nothing
        
    Application.ScreenUpdating = True
        
    End Sub
    

      

  • 相关阅读:
    好的文章聚集地
    java连接mysql数据库8.0以上版本过程中遇到的坑
    Tomcat8.5安装与配置的坑
    用阿里fastJson解析Json字符串
    通过java代码HttpRequestUtil(服务器端)发送HTTP请求并解析
    Vue中美元$符号的意思
    java的jdk和jre区别
    java正则
    java8 四大核心函数式接口Function、Consumer、Supplier、Predicate(转载)
    SpringBoot:静态资源的访问和配置(转载)
  • 原文地址:https://www.cnblogs.com/nextseven/p/8437066.html
Copyright © 2011-2022 走看看