12
返回列表 上一主題 發帖

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

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2016-3-4 17:45 | 只看該作者

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

請問各位大大~
資料非常大，但目前只想確認如下面狀態，該如何去判斷需求呢?有大大可以幫忙看一下嗎?


在開始和結束，這區間內
若以(NET DGND
可以去判斷這個區間的結果，有無符合需求?

需求1:
若區間內，只出現一次portRef則判斷(net DGND這個開始，是異常的
並且列表於儲存格中A列中

需求2:
若區間內，portRef出現多次，若有GND和VDD這兩種字眼，這樣也算是異常
並且列表於儲存格中A列中

--------------------------------------
(net DGND
              (joined
                (portRef DGND)
                (portRef GND
                  (instanceRef INS55717393))
                (portRef VDD
                  (instanceRef INS55717393)))
              (figure WIRE
                (path
                  (pointList
                    (pt 610 -380)
                    (pt 600 -380)
                    (pt 600 -400))))
              (figure WIRE
                (path
                  (pointList
                    (pt 760 -320)
                    (pt 740 -320)))))

收藏 分享

boblovejoyce

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

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 
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 
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 
10#
發表於 2016-3-10 08:37 | 只看該作者
回復 9# boblovejoyce

喔~把這個改成InStr，就有值了~
If InStr(T, "(portRef GND") > 0 Then Cx(1) = 1: GoTo 101
If InStr(T, "(portRef VDD") > 0 Then Cx(2) = 1: GoTo 101

謝謝

TOP

boblovejoyce

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


    謝謝回覆~
因為規則很多，這只是其中一個規則
我的規則，是在掃描只要有(net
就開始去判斷~
結尾不一定是)))))
結尾應該算是下一個(net之前~

我測試了~在這個固定的規則下，是OK的 (可是我有將CX(0)改成小於3)
逐行執行時，CX(1) CX(2) 始終沒有值
請教為什麼會沒有值?

TOP

boblovejoyce

帖子
38 
主題
7 
精華
0 
積分
48 
點名
0  
作業系統
win8 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-4-30 
最後登錄
2016-12-5 
8#
發表於 2016-3-9 17:46 | 只看該作者
回復 6# stillfish00
謝謝回覆~可以處理
雖然我有試過數量行數很多時，我跑了一個小時~它才再繼續check和寫入
因為我的資料數量可以達到50萬行以上
然後又有重重的關係~~
如果有CHECK OK的，不需要寫入顯示出來，應該就會快些

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
7#
發表於 2016-3-8 21:51 | 只看該作者
只用簡單的規則，
(net DGND　表示開頭，
遇５個右括號　)))))　為結尾，
若非此規則，不須再參考以下內容！

將文字檔貼至Ａ欄，檢測有異常，在Ｂ欄以文字表示：
Sub TEST()
Dim xR As Range, T$, xH As Range, Cx
[B:B].ClearContents
For Each xR In Range([A1], Cells(Rows.Count, 1).End(xlUp))
　　T = Trim(xR)
　　If T = "(net DGND" Then Set xH = xR: ReDim Cx(3): GoTo 101
　　If xH Is Nothing Then GoTo 101
　　If InStr(xR, "portRef") Then Cx(0) = Cx(0) + 1
　　If T = "(portRef GND" Then Cx(1) = 1: GoTo 101
　　If T = "(portRef VDD" Then Cx(2) = 1: GoTo 101
　　If Right(T, 5) = ")))))" Then
　　　　If Val(Cx(0)) < 2 Then Cx(3) = 1
　　　　If Cx(1) + Cx(2) > 1 Then Cx(3) = 2
　　　　If Cx(3) > 0 Then Range(xH(1, 2), xR(1, 2)) = "異常(" & Cx(3) & ")"
　　　　Set xH = Nothing
　　End If
101: Next
End Sub

參考檔：
http://www.funp.net/634979

TOP

stillfish00

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

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
12
返回列表 上一主題