当前位置:编程学习 > VB >>

获取详细变更的件数

Type CHANGEDETAIL
  strChangeDetailNo As String '变更详细内容的件数
  strChangeDetail As String '变更详细内容
  strChangeNo As String    '变更番号(大)
  strTemp As String
End Type

Type CNANGEPOINT
  strChangePoint() As CHANGEDETAIL
  strTemp As String
End Type

Dim myChangePoint As CNANGEPOINT

Sub Macro2()
    Dim rngTest As Range

    Set rngTest = Range("F5:F100")
    Call getContext(rngTest)
    '对每个大的变更点,继续细分到每条小的变更点。
    '用这个count

    Erase myChangePoint.strChangePoint()
End Sub

Function getContext(rngTst As Range)
    Dim iRngColumn As Integer
    Dim iRngStartRow As Integer
    Dim iRngEndRow As Integer
    Dim iCountPoint As Integer
    Dim iCountDetail As Integer
    Dim i, iCount As Integer
    Dim iLength As Integer

    iRngStartRow = rngTst.Row
    iRngEndRow = iRngStartRow + rngTst.Rows.Count - 1
    iRngColumn = rngTst.Column

    iCountPoint = 0
    iCountDetail = 0
    'For Each oCell In rngTst
    For i = iRngStartRow To iRngEndRow
        '是否需要作为变更点进行统计
        '如果该单元格没有变更番号,并且没有变更内容,则不作为变更点
        If (Cells(i, iRngColumn).Text = "" And Cells(i, iRngColumn).Offset(0, 1).Text = "") Then

        Else
        '如果在变更番号或者变更内容中不为空的话
            '是否是合并单元格
            If (Cells(i, iRngColumn).MergeCells) Then
                '首先作为一个大变更点计,但是需要记录next cell的坐标
                iCountPoint = iCountPoint + 1
                ReDim Preserve myChangePoint.strChangePoint(1 To iCountPoint)
                myChangePoint.strChangePoint(iCountPoint).strChangeNo = Cells(i, iRngColumn).Text
                '对于合并单元格,需要将复数个单元格的内容
                For iCount = 0 To GetMergeCellRow(Cells(i, iRngColumn)) - 1
                    myChangePoint.strChangePoint(iCountPoint).strChangeDetail = myChangePoint.strChangePoint(iCountPoint).strChangeDetail & vbLf & Cells(i + iCount, iRngColumn).Offset(0, 1).Text
                Next iCount
                'Debug.Print myChangePoint.strChangePoint(iCountPoint).strChangeDetail
                myChangePoint.strChangePoint(iCountPoint).strChangeDetailNo = GetChangeDetail(myChangePoint.strChangePoint(iCountPoint).strChangeDetail)
                i = i + GetMergeCellRow(Cells(i, iRngColumn)) - 1 ''需要跳过合并单元格的列数,因为循环一次i会自增1,所以这里先扣一次
            Else
            '不是合并单元格,首先作为一个大变更点计数
                iCountPoint = iCountPoint + 1
                ReDim Preserve myChangePoint.strChangePoint(1 To iCountPoint)
                myChangePoint.strChangePoint(iCountPoint).strChangeNo = Cells(i, iRngColumn).Text
                myChangePoint.strChangePoint(iCountPoint).strChangeDetail = Cells(i, iRngColumn).Offset(0, 1).Text
                'Debug.Print myChangePoint.strChangePoint(iCountPoint).strChangeDetail
                myChangePoint.strChangePoint(iCountPoint).strChangeDetailNo = GetChangeDetail(myChangePoint.strChangePoint(iCountPoint).strChangeDetail)
            End If
        End If
    Next i
End Function

Function GetMergeCellRow(oCell As Range) As Integer
    Dim i As Integer
    Dim TempCell As Range
    Dim TempCell2 As Range

    i = 0
    Set TempCell = oCell
    Set TempCell2 = TempCell.Offset(1, 0)
    GetMergeCellRow = TempCell2.Row - TempCell.Row   '返回合并单元格的row数

End Function

'返回变更明细的变更件数
Function GetChangeDetail(ByRef strDetail As String) As Integer
    Dim arrDetail() As String
    Dim i As Integer
    Dim sTemp As String
    Dim iCount As Integer

    iCount = 0
    '将变更明细按行分割
    arrDetail = Split(strDetail, vbLf)
    '对于分割出来的每一行,判断开头是否存在编号记号,如果属于编号,则变更点加1
    For i = 0 To UBound(arrDetail)
        sTemp = arrDetail(i)
        sTemp = LTrim(sTemp)
        sTemp = RTrim(sTemp)
        If sTemp Like "[1-9]*[.、]*" Then     '以若干个数字开头(比如000,11,99999等等),接下来是"."或者"、",接下来是任意字符。
            iCount = iCount + 1
        Else

        End If
    Next i

    GetChangeDetail = iCount
End Function --------------------编程问答-------------------- 贴一段代码上来, 问题呢?
补充:VB ,  VBA
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,