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
uj5u.com熱心網友回復：
貼一段代碼上來, 問題呢?轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/132491.html
標籤：VBA
上一篇：有誰見過專門識別數字的螢屏OCR軟體沒?只要識別數字別的不要,螢屏識別不是圖片識別.多謝!!
下一篇：人體動作識別特征提取與分類