12
返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
11# 跳轉到 »
發表於 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

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
12#
發表於 2016-3-11 15:21 | 只看該作者
回復 11# stillfish00

謝謝大大的回覆~
目前不解的是，為何跑完後，會有這幾個項次?
附上我的讀取檔案
test0311.rar (34.99 KB)
&10104
&10306
&10208
&10205
&10108
&10314
&10414
&10102
&10311
&10204
&10115

test0311.rar (34.99 KB)

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
13#
發表於 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

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
14#
發表於 2016-3-14 11:27 | 只看該作者
回復 13# stillfish00
謝謝大大~調整
測試後，正常又快速~:)

TOP

        靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。
12
返回列表 上一主題