获取详细变更的件数

最新推荐文章于 2025-06-15 00:47:57 发布

转载最新推荐文章于 2025-06-15 00:47:57 发布 · 494 阅读

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