返回列表 上一主題 發帖

[發問] 比較一堆資料中規則問題，能否判讀

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 2016-3-8 11:09 | 顯示全部帖子
回復 1# boblovejoyce
草草完成如下程式，
因為VB的正則表達式功能弱了點
所以又自己寫了 FindCloseBracket 找出匹配的右括號位置
  1. Sub Test()
  2.     Dim fn As Integer, allText As String, indexClose As Long
  3.     Dim fname
  4.     fname = Application.GetOpenFilename()
  5.     If TypeName(fname) = "Boolean" Then Exit Sub
  6.     fn = FreeFile()
  7.     Open fname For Input As #fn
  8.     allText = Input$(LOF(1), 1)
  9.     Close #fn
  10.    
  11.     Sheets.Add
  12.     Cells(1, 1).Resize(, 3) = Array("net", "check", "portRef")
  13.     Dim oRegex As Object: Set oRegex = CreateObject("vbscript.regexp")
  14.     Dim oMch As Object, oMch2 As Object, x, i As Long, j As Long, endindex As Long
  15.     Dim hasVDD As Boolean, hasGND As Boolean
  16.     With oRegex
  17.         .Global = True
  18.         .Pattern = "\(net\s+([^\s()]*)"     '(net 開頭，捕捉下一個非空白或()的字組
  19.         Set oMch = .Execute(allText)
  20.         
  21.         .Pattern = "\(portRef\s+([^\s()]*)"     '(portRef 開頭，捕捉下一個非空白或()的字組
  22.         i = 2
  23.         For Each x In oMch
  24.             endindex = FindCloseBracket(allText, x.firstIndex)
  25.             Set oMch2 = .Execute(Mid(allText, x.firstIndex, endindex - x.firstIndex + 1))
  26.             Cells(i, 1) = x.subMatches(0)
  27.             j = 3
  28.             hasVDD = False: hasGND = False
  29.             For Each y In oMch2
  30.                 If InStr(1, y.subMatches(0), "VDD", vbTextCompare) Then hasVDD = True
  31.                 If InStr(1, y.subMatches(0), "GND", vbTextCompare) Then hasGND = True
  32.                 Cells(i, j) = y.subMatches(0)
  33.                 j = j + 1
  34.             Next
  35.             Cells(i, 2) = IIf(oMch2.Count < 2 Or (hasVDD And hasGND), "X", "O")
  36.             
  37.             i = i + 1
  38.         Next
  39.     End With
  40. End Sub

  42. '   s: input string
  43. '   i: index of begin bracket "("
  44. Function FindCloseBracket(ByRef s As String, ByVal i As Long) As Long
  45.     Dim isInString As Boolean   'ex : 預防雙引號字串內的 () 誤判
  46.     i = i + 1   '從下一個字元開始
  47.     Do While i <= Len(s)
  48.         Select Case Mid(s, i, 1)
  49.         Case "("
  50.             If Not isInString Then
  51.                 i = FindCloseBracket(s, i)
  52.                 If i = 0 Then Exit Do
  53.             End If
  54.         Case ")"
  55.             If Not isInString Then
  56.                 FindCloseBracket = i
  57.                 Exit Function
  58.             End If
  59.         Case """"
  60.             isInString = Not isInString
  61.         Case Else
  62.         End Select
  63.         
  64.         i = i + 1
  65.         DoEvents
  66.     Loop
  67.     FindCloseBracket = 0
  68. End Function
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2016-3-10 09:37 | 顯示全部帖子
回復 8# boblovejoyce
資料那麼多筆要先講，上傳的檔案才兩筆就沒有優化了
  1. Sub Test()   
  2.     '== Read File ==
  3.     Dim fn As Integer, allText As String
  4.     Dim fname
  5.     fname = Application.GetOpenFilename()
  6.     If TypeName(fname) = "Boolean" Then Exit Sub
  7.     fn = FreeFile()
  8.     Open fname For Input As #fn
  9.     allText = Input$(LOF(1), 1)
  10.     Close #fn
  11.         
  12.     '== Parse Element ==
  13.     Dim oRegex As Object: Set oRegex = CreateObject("vbscript.regexp")
  14.     Dim oDic As Object: Set oDic = CreateObject("scripting.dictionary")
  15.     Dim oMch As Object, oMch2 As Object, x, i As Long, j As Long, endIndex As Long
  16.     Dim hasVDD As Boolean, hasGND As Boolean
  17.     With oRegex
  18.         .Global = True
  19.         .Pattern = "\(net\s+([^\s()]*)"     '(net 開頭，捕捉下一個非空白或()的字組
  20.         Set oMch = .Execute(allText)
  21.         
  22.         .Pattern = "\(portRef\s+([^\s()]*)"     '(portRef 開頭，捕捉下一個非空白或()的字組
  23.         i = 1
  24.         For Each x In oMch
  25.             endIndex = FindCloseBracket(allText, x.firstIndex)
  26.             If endIndex = 0 Then MsgBox "Fail to parse: " & vbNewLine & Mid(allText, x.firstIndex, 50) & "...": Exit Sub
  27.             Set oMch2 = .Execute(Mid(allText, x.firstIndex, endIndex - x.firstIndex + 1))
  28.             
  29.             hasVDD = False: hasGND = False
  30.             For Each y In oMch2
  31.                 If InStr(1, y.subMatches(0), "VDD", vbTextCompare) Then hasVDD = True
  32.                 If InStr(1, y.subMatches(0), "GND", vbTextCompare) Then hasGND = True
  33.             Next
  34.             
  35.             If oMch2.Count < 2 Or (hasVDD And hasGND) Then  'portRef低於兩個或同時含VDD及GND字串
  36.                 oDic.Add i, x.subMatches(0)
  37.                 i = i + 1
  38.             End If
  39.         Next
  40.     End With
  41.    
  42.     '== Output result ==
  43.     Dim ar
  44.     If oDic.Count = 0 Then MsgBox "All pass": Exit Sub
  45.     ar = oDic.items
  46.     With Sheets.Add
  47.         Application.ScreenUpdating = False
  48.         .[a1].Resize(UBound(ar) - LBound(ar) + 1) = OneDtoTwoD(ar)
  49.         Application.ScreenUpdating = True
  50.     End With
  51. End Sub

  53. '   s: input string
  54. '   i: index of begin bracket "("
  55. Function FindCloseBracket(ByRef s As String, ByVal i As Long) As Long
  56.     Dim isInString As Boolean   'ex : 預防雙引號字串內的 () 誤判
  57.     i = i + 1   '從下一個字元開始
  58.     Do While i <= Len(s)
  59.         Select Case Mid(s, i, 1)
  60.         Case "("
  61.             If Not isInString Then
  62.                 i = FindCloseBracket(s, i)
  63.                 If i = 0 Then Exit Do
  64.             End If
  65.         Case ")"
  66.             If Not isInString Then
  67.                 FindCloseBracket = i
  68.                 Exit Function
  69.             End If
  70.         Case """"
  71.             isInString = Not isInString
  72.         Case Else
  73.         End Select
  74.         i = i + 1
  75.     Loop
  76.     FindCloseBracket = 0
  77. End Function

  79. Function OneDtoTwoD(ar, Optional base As Integer) As Variant    'transepose array of elements > 65535
  80.     Dim i, retn()
  81.     ReDim retn(base To base + UBound(ar) - LBound(ar), base To base)  ' transe to base
  82.     For i = LBound(ar) To UBound(ar)
  83.         retn(i - LBound(ar) + base, base) = ar(i)
  84.     Next
  85.     OneDtoTwoD = retn
  86. End Function
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2016-3-11 19:39 | 顯示全部帖子
本帖最後由 stillfish00 於 2016-3-11 19:42 編輯

回復 12# boblovejoyce
恩，firstIndex 這邊我錯了，match到第一個字時 firstIndex = 0，和VBA不一樣，難怪跑那麼久，修改如下

然後有些rename的我不知要取哪個名稱，都寫到第一欄
  1. Sub Test()
  2.     '== Read File ==
  3.     Dim fn As Integer, allText As String
  4.     Dim fname
  5.     fname = Application.GetOpenFilename()
  6.     If TypeName(fname) = "Boolean" Then Exit Sub
  7.     fn = FreeFile()
  8.     Open fname For Input As #fn
  9.     allText = Input$(LOF(1), 1)
  10.     Close #fn
  11.         
  12.     '== Parse Element ==
  13.     Dim oRegex As Object: Set oRegex = CreateObject("vbscript.regexp")
  14.     Dim oDic As Object: Set oDic = CreateObject("scripting.dictionary")
  15.     Dim omch As Object, oMch2 As Object, x, i As Long, j As Long, endIndex As Long
  16.     Dim hasVDD As Boolean, hasGND As Boolean
  17.     With oRegex
  18.         .Global = True
  19.         .Pattern = "\(net\s+(\(rename.*\)|[^\s()]*)"     '(net 開頭，捕捉下一個非空白或()的字組或rename...
  20.         Set omch = .Execute(allText)
  21.         
  22.         .Pattern = "\(portRef\s+([^\s()]*)"     '(portRef 開頭，捕捉下一個非空白或()的字組
  23.         i = 1
  24.         For Each x In omch
  25.             endIndex = FindCloseBracket(allText, x.firstIndex + 1)
  26.             If endIndex = 0 Then MsgBox "Fail to parse: " & vbNewLine & Mid(allText, (x.firstIndex + 1), 50) & "...": Exit Sub
  27.             Set oMch2 = .Execute(Mid(allText, x.firstIndex + 1, endIndex - (x.firstIndex + 1) + 1))
  28.             
  29.             hasVDD = False: hasGND = False
  30.             For Each y In oMch2
  31.                 If InStr(1, y.subMatches(0), "VDD", vbTextCompare) Then hasVDD = True
  32.                 If InStr(1, y.subMatches(0), "GND", vbTextCompare) Then hasGND = True
  33.             Next
  34.             
  35.             If oMch2.Count < 2 Or (hasVDD And hasGND) Then  'portRef低於兩個或同時含VDD及GND字串
  36.                 oDic.Add i, x.subMatches(0)
  37.                 i = i + 1
  38.             End If
  39.         Next
  40.     End With
  41.    
  42.     '== Output result ==
  43.     Dim ar
  44.     If oDic.Count = 0 Then MsgBox "All pass": Exit Sub
  45.     ar = oDic.items
  46.     With Sheets.Add
  47.         Application.ScreenUpdating = False
  48.         .[a1].Resize(UBound(ar) - LBound(ar) + 1) = OneDtoTwoD(ar)
  49.         Application.ScreenUpdating = True
  50.     End With
  51. End Sub

  53. '   s: input string
  54. '   i: index of begin bracket "("
  55. Function FindCloseBracket(ByRef s As String, ByVal i As Long) As Long
  56.     Dim isInString As Boolean   'ex : 預防雙引號字串內的 () 誤判
  57.     i = i + 1   '從下一個字元開始
  58.     Do While i <= Len(s)
  59.         Select Case Mid(s, i, 1)
  60.         Case "("
  61.             If Not isInString Then
  62.                 i = FindCloseBracket(s, i)
  63.                 If i = 0 Then Exit Do
  64.             End If
  65.         Case ")"
  66.             If Not isInString Then
  67.                 FindCloseBracket = i
  68.                 Exit Function
  69.             End If
  70.         Case """"
  71.             isInString = Not isInString
  72.         Case Else
  73.         End Select
  74.         i = i + 1
  75.     Loop
  76.     FindCloseBracket = 0
  77. End Function

  79. Function OneDtoTwoD(ar, Optional base As Integer) As Variant    'transepose array of elements > 65535
  80.     Dim i, retn()
  81.     ReDim retn(base To base + UBound(ar) - LBound(ar), base To base)  ' transe to base
  82.     For i = LBound(ar) To UBound(ar)
  83.         retn(i - LBound(ar) + base, base) = ar(i)
  84.     Next
  85.     OneDtoTwoD = retn
  86. End Function
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題