zoukankan      html  css  js  c++  java
  • vba 列转行

    
    
    Sub C2R()
        
        Dim RCount As Integer
        RCount = 2
        
        Dim FillIn, FillIn2
        Set FillIn = Worksheets("Fill-in Forms")
        Set FillIn2 = Worksheets("fillinforms2")
        
        
        Application.ScreenUpdating = False
        
        Dim ENCommentIndex%, OptionalForm%
        Dim OptionalList$
        OptionalList = "CA0106, CA0121, CA0121, CA0199, CA0240, CA0240, CA0305, CA0409, CA0410, CA0444, CA0444, CA2010, CA2010, CA2011, CA2033, CA2033, CA2048, CA2048, CA2054, CA2054, CA2055, CA2055, CA2067, CA2071, CA2071, CA2502, CA9910, CA9910, CA9916, CA9933, CA9933,"
        
        
        For Each EN In FillIn.Range("B2:DG2")
            
            ENCommentIndex = InStr(FillIn.Cells(2, EN.Column + 1).Value, EN.Value)
            OptionalForm = InStr(OptionalList, EN.Value)
            
            If InStr(EN.Value, "Comm") = 0 Then
                For Each Fill In FillIn.Range("A3:A166")
                    If Cells(Fill.Row, EN.Column).Value <> "" Then
                        EN.Copy (FillIn2.Range("A" & RCount)) 'en name
                        Fill.Copy (FillIn2.Range("B" & RCount)) 'field desc
                        Cells(Fill.Row, EN.Column).Copy (FillIn2.Range("C" & RCount)) 'X
                        
                        If ENCommentIndex > 0 Then
                            Cells(Fill.Row, EN.Column + 1).Copy (FillIn2.Range("D" & RCount)) 'comment
                        End If
                        
                        If OptionalForm = 0 Then
                            FillIn2.Range("E" & RCount) = "Conditional"
                        Else
                            FillIn2.Range("E" & RCount) = "Optional"
                        End If
                       
                        RCount = RCount + 1
                        
                    End If
                    
                Next
            End If
            
        Next
        
    End Sub
    
    
    Sub RemoveDeletedEN()
    
        Dim red_en$
        red_en = "CA2018, CA2018, CA2021, CA2021, CA2027, CA2027, CA2030, CA2030, CA2071, CA2071, CA9923, CA9923, CA9930, CA9930, CA9960, CA9960, CA2016, CA2016, CA2017, CA2017,"
        
        Dim fillinforms2
        Set fillinforms2 = Worksheets("fillinforms2")
        
        For Each EN In fillinforms2.Range("A2:A300")
            
            If EN.Value <> "" And InStr(red_en, EN.Value) <> 0 Then
                fillinforms2.Range("F" & EN.Row) = "deleted"
            End If
        
        Next
        
    End Sub
    
    
  • 相关阅读:
    导入测试用例的设计
    质量管理的精髓
    ios crash的原因与抓取crash日志的方法
    怎样实现excel隔行隔列变色效果的方法
    如何提高员工的质量意识?
    史上最全的测试团队组建方法
    如何写好缺陷报告?
    你还不知道?这四个因素决定了你的养老金待遇!
    各手机截屏方法收集
    利用drozer进行Android渗透测试
  • 原文地址:https://www.cnblogs.com/wancy86/p/7073986.html
Copyright © 2011-2022 走看看