Board logo

標題: [發問] 如何載入一檔案並判斷特定欄位做運算後產生一新檔案(內含舊檔與運算後之結果) [打印本頁]
作者: happycoccolin    時間: 2014-12-16 11:54     標題: 如何載入一檔案並判斷特定欄位做運算後產生一新檔案(內含舊檔與運算後之結果)

大家好~~
最近有個問題想請教一下
目前已經寫好函數,但因為需要人工處理且檔案眾多,想要將之轉成程式執行,想拜託大大們協助~~

如下

公式

『C』：

IF(O1="C",IF(『擷取M1欄"/"後字元』*0.6>Q1,PASS,FAIL))

『非0 ohm』：ohm類的字元前面可能帶空格,部分未帶空格

IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/M1-M1*N1<W參閱項目2*0.6,PASS,FAIL)))
例如: W需要判斷P1只要有出現0402字元就= 0.0625最下面有一對應表格
且M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
例如:M1=2.64Kohm=2.64*1000=2640
IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))

『0ohm』：ohm類的字元前面可能帶空格,部分未帶空格

IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1< W參閱項目2*0.6,PASS,FAIL)))
例如:W需要判斷P1只要有出現0402字元就= 0.0625 最下面有一對應表格
IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1<0.0625*0.6,PASS,FAIL)))

『Bead』：

IF(O1="Bead",IF(Q1平方<『判斷F1欄”/”後字元,若出現mA字元,其值要÷1000反之則否』平方*0.6,PASS,FAIL)))
例如:F1值=FERRITE BEAD(0402)600OHM/300mA,則執行”/”後字元=300mA=300/1000
IF(O1="Bead",IF(Q1平方<0.3平方*0.6,PASS,FAIL)))

項目說明
1.組值換算(以歐姆值計算ohm、若為Kohm：其值×1000、若為Mohm：其值×1000000)
2.W(瓦特數)：有一對應表格見此文最下方,需與「PCB Footprint」欄位對應並做判斷


零件大小與功率對應表：
零件大小        功率(W)
0402        0.0625
0603        0.1
0805        0.125
1206        0.25
1210        0.3333
1812        0.5
2010        0.75
2512        1

目前希望能夠建立一個檔案,然後我可以載入一個表格,經過運算後產生一個新檔案並會跳出視窗詢問要不要儲存一個新檔

將運算後的結果PASS or FAIL 顯示在表格最後一欄(表頭為PASS/FAIL)

PASS顯示綠底黑字 FAIL顯示紅底白字 若兩者皆非(表示前面判斷O欄位即非我們上述的關鍵字)請顯示空白即可


附檔為需要運算比對的檔案,還請各位大大牛刀小試一下,拜託拜託~~謝謝大家~

[attach]19824[/attach]
作者: happycoccolin    時間: 2014-12-17 15:22

不知道有沒有大大願意撥時間看看呢?

小妹對上VBA腦筋就轉不過來了,還請各位大大解救

若有解釋不清的地方也請不吝提出問題~

謝謝~~
作者: GBKEE    時間: 2014-12-18 12:25

本帖最後由 GBKEE 於 2014-12-22 16:51 編輯

回復 2# happycoccolin
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR, Sh As Worksheet
  4.     Dim i As Long, Msg As Variant, W As Single, M As Single, s As String, filein As String, fileout As String
  5.      filein = Application.GetOpenFilename(FileFilter:="Excel 活頁簿 (*.xlsx),*.xlsx", Title:="請選擇要比對的檔案")
  6.      If Not TypeName(filein) = "String" Then Exit Sub '取消則結束
  7.      With Workbooks.Open(filein)
  8.         Set Sh = .Sheets(1)
  9.         AR = Sh.UsedRange.Columns("S")
  10.      End With
  11.     AR(1, 1) = "PASS/FAIL"
  12.     For i = 2 To UBound(AR)
  13.         Msg = ""
  14.         Select Case Cells(i, "O")
  15.             
  16.             Case ""
  17.                 '**********************************************************************
  18.                 '2.若是O欄(Implementation)為空,請在S欄位(結果欄位)顯示"無工作電壓/電流"
  19.                 Msg = "無工作電壓/電流"
  20.             Case "C"
  21.                 'IF(O1="C",IF(『擷取M1欄"/"後字元』*0.6>Q1,PASS,FAIL))
  22.                 Msg = Val(Split(Cells(i, "M"), "/")(1)) * 0.6 > Cells(i, "Q")
  23.             Case "R"
  24.                 Msg = Split(Cells(i, "P"), "_")   'Msg = P欄中用 "_" 字串分割傳回的陣列
  25.                 If UBound(Msg) = 0 Then           '陣列元素只有一個,P欄中沒有"_"的字元
  26.                     Msg = Split(Cells(i, "P"), "_")(0)
  27.                 ElseIf UBound(Msg) > 0 Then        'P欄中有"_"的字元
  28.                     Msg = Split(Cells(i, "P"), "_")(1)
  29.                     If Mid(UCase(Msg), 1, 1) = "H" Then
  30.                       '"r0603_hxx"(xx是變數) : r+後四碼字串_hxx
  31.                         Msg = Split(Cells(i, "P"), "_")(0)
  32.                     End If
  33.                 End If
  34.                 W = 0
  35.                 Select Case Right(Trim(Msg), 4)  ' P欄後4碼字串
  36.                     Case "0402"           '零件大小
  37.                         W = 0.0625        '功率(W)
  38.                     Case "0603"
  39.                         W = 0.1
  40.                     Case "0805"
  41.                         W = 0.125
  42.                     Case "1206"
  43.                         W = 0.25
  44.                     Case "1210"
  45.                         W = 0.3333
  46.                     Case "1812"
  47.                         W = 0.5
  48.                     Case "2010"
  49.                         W = 0.75
  50.                     Case "2512"
  51.                         W = 1
  52.                 End Select
  53.                 '**********************************************************************
  54.                 '4.以下這段,若是Kohm & Mohm中間帶一個空格(K ohm & M ohm),一樣可以判斷出來嗎?
  55.                 '**************************************************************************
  56.                 Msg = UCase(Right(Trim(Cells(i, "M")), 5))
  57.                
  58.                 If Msg = "K OHM" Or Msg = "M OHM" Then   '讀取5個字元,取得歐姆單位
  59.                     'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
  60.                     '例如:M1=2.64Kohm=2.64*1000=2640
  61.                      M = Val(Cells(i, "M")) * 10000        'Kohm
  62.                     If Msg = "M OHM" Then M = Val(Cells(i, "M")) * 1000000
  63.                     'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))
  64.                     Msg = Cells(i, "Q") ^ 2 / M - M * Cells(i, "N") < W * 0.6
  65.                 End If
  66.                
  67.                 If Not IsNumeric(Msg) Then                      '5個字元,非歐姆單位
  68.                     Msg = UCase(Right(Trim(Cells(i, "M")), 4))  '讀取4個字元,取得歐姆單位
  69.                     If Msg = "0OHM" Or Msg = " OHM" Then  '『非0 ohm』：ohm類的字元前面可能帶空格,部分未帶空格
  70.                         'IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1< W參閱項目2*0.6,PASS,FAIL)))
  71.                         M = Val(Cells(i, "M"))
  72.                         Msg = Cells(i, "Q") ^ 2 * Cells(i, "N") < W * 0.6
  73.                     ElseIf Msg = "KOHM" Or Msg = "MOHM" Then
  74.                         'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
  75.                         '例如:M1=2.64Kohm=2.64*1000=2640
  76.                         M = Val(Cells(i, "M")) * 10000        'Kohm
  77.                         If Msg = "MOHM" Then M = Val(Cells(i, "M")) * 1000000
  78.                         'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))
  79.                         Msg = Cells(i, "Q") ^ 2 / M - M * Cells(i, "N") < W * 0.6
  80.                     End If
  81.                 End If
  82.                 If Not IsNumeric(Msg) Then                  '4個字元,非歐姆單位
  83.                     Msg = UCase(Right(Trim(Cells(i, "M")), 3))  '剩下3個字元,最小的歐姆單位
  84.                     M = Val(Cells(i, "M"))
  85.                     Msg = Cells(i, "Q") ^ 2 * Cells(i, "N") < W * 0.6
  86.                
  87.                 End If
  88.             Case "BEAD"
  89.                 'IF(O1="Bead",IF(Q1平方<『判斷F1欄”/”後字元,若出現mA字元,其值要÷1000反之則否』平方*0.6,PASS,FAIL)))
  90.                 '例如:F1值=FERRITE BEAD(0402)600OHM/300mA,則執行”/”後字元=300mA=300/1000
  91.                 'IF(O1="Bead",IF(Q1平方<0.3平方*0.6,PASS,FAIL)))
  92.                 If InStr(Cells(i, "f"), "/") Then   '判斷F1欄 有”/”此字元
  93.                     M = Val(Split(Cells(i, "f"), "/")(1))
  94.                     Msg = InStr(UCase(Split(Cells(i, "f"), "/")(1)), "MA")
  95.                     If Msg Then M = Val(Split(Cells(i, "f"), "/")(1)) / 1000
  96.                     Msg = Cells(i, "Q") ^ 2 > M
  97.                 End If
  98.         End Select
  99.         If Msg <> "" Then
  100.             If Msg = "無工作電壓/電流" Then
  101.                 AR(i, 1) = Msg
  102.             Else
  103.                 AR(i, 1) = IIf(Msg, "PASS", "FAIL")
  104.             End If
  105.         End If
  106.     Next
  107.    
  108.     With Sh.UsedRange.Columns("S")
  109.         .Cells = AR
  110.         Msg = Array("PASS", "FAIL")
  111.         For i = 0 To UBound(Msg)
  112.             .Replace Msg(i), "=EX", xlWhole
  113.              With .SpecialCells(xlCellTypeFormulas, xlErrors)
  114.                 .Cells = Msg(i)
  115.                 'PASS顯示綠底黑字 FAIL顯示紅底白字
  116.                 .Font.Color = IIf(i = 0, vbBlack, vbWhite)
  117.                 .Interior.Color = IIf(i = 0, vbGreen, vbRed)
  118.              End With
  119.         
  120.         Next
  121.         .SpecialCells(xlCellTypeConstants).EntireRow.Copy
  122.     End With
  123.      '**********************************************************
  124.     '1.我目前是想做成我可以執行此程式後跳出一個視窗->讓我挑選要載入的檔案->載入後執行運算->跳出視窗讓我可另存新檔~
  125.    If MsgBox("請問是否要儲存檔案?", vbYesNo) = vbYes Then
  126.         fileout = Application.GetSaveAsFilename(FileFilter:="Excel 活頁簿 (*.xlsx),*.xlsx", Title:="另存為新檔")
  127.         If Not TypeName(fileout) = "String" Then Exit Sub '取消則結束
  128.         With Workbooks.Add(1)
  129.             .Sheets(1).Paste
  130.             .SaveAs fileout ', FileFormat:=xlWorkbookDefault
  131.             .Close True
  132.         End With
  133.     Else
  134.          Application.CutCopyMode = False
  135.       
  136.     End If

  138.     '******************************
  139.     '1不要將結果顯示在原檔案
  140.     Sh.Parent.Close False
  141.    
  142. End Sub
複製代碼
作者: happycoccolin    時間: 2014-12-18 17:15

回復 3# GBKEE


    謝謝板大的幫忙~~~~

但是我執行時停在這行~還沒能載入檔案~可以幫忙看看嗎~~~謝謝~~~~~
Sub Ex()
    Dim AR, SH As Worksheet
    Dim i As Long, Msg As Variant, W As Single, M As Single
    Set SH = ActiveSheet
    With SH.UsedRange
        .Columns("S").Clear
        AR = .Columns("S")
    End With
AR(1, 1) = "PASS/FAIL" <-停在此行
For i = 2 To UBound(AR)
作者: happycoccolin    時間: 2014-12-19 11:02

回復 3# GBKEE


Hi~版大~~~

請問一下~

1.我目前是想做成我可以執行此程式後跳出一個視窗->讓我挑選要載入的檔案->載入後執行運算->跳出視窗讓我可另存新檔~
不要將結果顯示在原檔案

2.若是O欄(Implementation)為空,請在S欄位(結果欄位)顯示"無工作電壓/電流"

3.另外,若是針對"R"的部分,在P欄會出現"r0603_hxx"(xx是變數) or "r0603"的字元,一樣可以判斷出來嗎?(原先是預設為:mx_r0603)            
                Select Case Right(Trim(Cells(i, "P")), 4) ' P欄後4碼字串
                    Case "0402"           '零件大小
                        W = 0.0625        '功率(W)
                    Case "0603"
                        W = 0.1
                    Case "0805"
                        W = 0.125
                    Case "1206"
                        W = 0.25
                    Case "1210"
                        W = 0.3333
                    Case "1812"
                        W = 0.5
                    Case "2010"
                        W = 0.75
                    Case "2512"
                        W = 1
                End Select

4.以下這段,若是Kohm & Mohm中間帶一個空格(K ohm & M ohm),一樣可以判斷出來嗎?
If Msg = "0OHM" Or Msg = " OHM" Then  '『非0 ohm』：ohm類的字元前面可能帶空格,部分未帶空格
                    'IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1< W參閱項目2*0.6,PASS,FAIL)))
                    M = Val(Cells(i, "M"))
                    Msg = Cells(i, "Q") ^ 2 * Cells(i, "N") < W * 0.6
                Else         '<>"0OHM" Or <> " OHM"
                    'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
                    '例如:M1=2.64Kohm=2.64*1000=2640
                     M = Val(Cells(i, "M")) * 10000        'Kohm
                    If Msg = "MOHM" Then M = Val(Cells(i, "M")) * 1000000
                    'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))
                    Msg = Cells(i, "Q") ^ 2 / M - M * Cells(i, "N") < W * 0.6
                End If

以上問題還請大大幫忙解答~~~~~小妹感激不盡~~
作者: GBKEE    時間: 2014-12-20 05:46

回復 5# happycoccolin
3#程式碼已更新,請試試看.
3.另外,若是針對"R"的部分,在P欄會出現"r0603_hxx"(xx是變數) or "r0603"的字元,一樣可以判斷出來嗎?(原先是預設為:mx_r0603)
請出示 P欄所有要處裡的字串元範例
作者: happycoccolin    時間: 2014-12-22 10:25

回復 6# GBKEE


    感謝版大~~~~^______^

不好意思啦~我表達的不好~我想要的方式如附檔[attach]19888[/attach]

1.我會用一個按鈕連結執行巨集(檔案為TEST_20141222.xlsm)

按下按鈕後開始執行->選取要運算的檔案(範例:MATERIALS.xlsx)->執行運算->跳出一新檔案並詢問要不要儲存

2.就上次的詢問"R"項目的P欄位需要判斷的增加如下兩種
"r0603_hxx"(xx是變數) : r+後四碼字串_hxx
"r0603" : r+後四碼字串


再次感謝版大耐心解答
作者: happycoccolin    時間: 2014-12-22 14:17

回復 6# GBKEE


    謝謝版大的迅速回覆^___^

請問是否可以讓user任選想要比對的檔案及檔案位置(User想運算的檔案可能存在任何位置)呢?

之前有另一個程式的語法如下
是否可以使用這樣的方式呢?
再拜託版大幫忙參考看看~~感激不盡~~~

--------------------------------------

  filein = Application.GetOpenFilename(FileFilter:="Excel 活頁簿 (*.xlsx),*.xlsx", Title:="請選擇要比對的檔案")
  If Not TypeName(filein) = "String" Then Exit Sub '取消則結束

--------------------------------------
If MsgBox("請問是否要儲存檔案?", vbYesNo) = vbYes Then
      fileout = Application.GetSaveAsFilename(FileFilter:="Excel 活頁簿 (*.xlsx),*.xlsx", Title:="另存為新檔")
      If Not TypeName(fileout) = "String" Then Exit Sub '取消則結束
      .SaveAs fileout, FileFormat:=xlWorkbookDefault
    End If
--------------------------------------
作者: GBKEE    時間: 2014-12-22 14:22

回復 8# happycoccolin
可以試著套上用,不行可再提問.
作者: happycoccolin    時間: 2014-12-22 15:26

回復 9# GBKEE


    Hi 版大

小妹不是很了解"不正確的引用",是否是少宣告了甚麼,還請版大協助~感激不盡~~~

停在此行
    .SaveAs fileout, FileFormat:=xlWorkbookDefault
請見附檔~謝謝~~~
[attach]19895[/attach]
作者: GBKEE    時間: 2014-12-22 15:41

本帖最後由 GBKEE 於 2014-12-22 15:48 編輯

回復 10# happycoccolin
錯誤請參考 http://forum.twbts.com/viewthread.php?tid=6733
  1.   '**********************************************************
  2.     '1.我目前是想做成我可以執行此程式後跳出一個視窗->讓我挑選要載入的檔案->載入後執行運算->跳出視窗讓我可另存新檔~
  3.    If MsgBox("請問是否要儲存檔案?", vbYesNo) = vbYes Then
  4.         fileout = Application.GetSaveAsFilename(FileFilter:="Excel 活頁簿 (*.xlsx),*.xlsx", Title:="另存為新檔")
  5.         If Not TypeName(fileout) = "String" Then Exit Sub '取消則結束
  6.         SH.Copy
  7.         With ActiveWorkbook
  8.             .SaveAs fileout ', FileFormat:=xlWorkbookDefault
  9.             .Close True
  10.         End With
  11.       
  12.     End If

  14.     '******************************
  15.     '1不要將結果顯示在原檔案
  16.     SH.Parent.Close False
  17.   
複製代碼
作者: happycoccolin    時間: 2014-12-22 16:21

回復 11# GBKEE


    Hi 版大~

對不起小妹不才
現在已經亂掉了..請版大幫忙指正好嗎~

如附檔

[attach]19897[/attach]
作者: happycoccolin    時間: 2014-12-22 17:10

回復 11# GBKEE


    感謝版大!!

我立刻來試試~~~


非常感激!!!
作者: happycoccolin    時間: 2014-12-22 18:27

回復 11# GBKEE


    版大~剛剛發現兩點要增加的~~~^^

1.
"C" 項目運算部分
在M欄位會出現KV的單位,需要*1000

'IF(O1="C",IF(『擷取M1欄"/"後字元』*0.6>Q1,PASS,FAIL))

意即"/"後字元若是帶KV,需要*1000

EX. 若M欄值為1000PF/2KV->提取出2KV=2*1000
公式為
'IF(O1="C",IF(2*1000*0.6>Q1,PASS,FAIL))

2."R"項目運算部分
'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
但是若是2.64ohm 即可直接運算,會變成
'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1^2/2.64-2.64*N1<0.0625*0.6,PASS,FAIL)))

請問未帶"K" &"M"的目前有做運算嗎?

還請撥冗幫忙看看~謝謝版大的幫忙~~^^
作者: happycoccolin    時間: 2014-12-24 14:31

回復 11# GBKEE


    Hi 版大~

請問一下版大~~我還有兩點需要增加~但是小妹想了兩天還是用不出結果,可以幫忙看看嗎~謝謝~
請看上則留言14#
作者: GBKEE    時間: 2014-12-24 16:04

回復 15# happycoccolin
寫不出結果沒關係,PO上妳所寫的,看看如何改.
作者: happycoccolin    時間: 2014-12-25 11:41

回復 16# GBKEE


    版大~~

我加上這段~但是除了"R" "BEAD"以外的東西都會消失不見[attach]19941[/attach]

------------------------------------------------------------------
                If Msg = "KV" Then
                    '在M欄位會出現KV的單位,需要*1000
                      M = Val(Cells(i, "M")) * 1000       'KV
                Msg = Val(Split(Cells(i, "M"), "/")(1)) * 0.6 > Cells(i, "Q")
------------------------------------------------------------------
"C" 項目運算部分
在M欄位會出現KV的單位,需要*1000

'IF(O1="C",IF(『擷取M1欄"/"後字元』*0.6>Q1,PASS,FAIL))

意即"/"後字元若是帶KV,需要*1000

EX. 若M欄值為1000PF/2KV->提取出2KV=2*1000
公式為
'IF(O1="C",IF(2*1000*0.6>Q1,PASS,FAIL))

以上是需求
-------------------------------------------------------------
然後發現有一個特殊狀況

"R"判斷 多出現了一個mx_c0603_hxx

這段我不會寫..還請版大撥空教學~~~拜託~~

    Case "R"
                Msg = Split(Cells(i, "P"), "_")   'Msg = P欄中用 "_" 字串分割傳回的陣列
                If UBound(Msg) = 0 Then           '陣列元素只有一個,P欄中沒有"_"的字元
                    Msg = Split(Cells(i, "P"), "_")(0)
                ElseIf UBound(Msg) > 0 Then        'P欄中有"_"的字元
                    Msg = Split(Cells(i, "P"), "_")(1)
                    If Mid(UCase(Msg), 1, 1) = "H" Then
                      '"r0603_hxx"(xx是變數) : r+後四碼字串_hxx
                        Msg = Split(Cells(i, "P"), "_")(0)
                    End If
作者: GBKEE    時間: 2014-12-25 21:30

回復 17# happycoccolin
請修改 看看
  1. Case "C"
  2.                 'IF(O1="C",IF(『擷取M1欄"/"後字元』*0.6>Q1,PASS,FAIL))
  3.                 If Right(Cells(i, "M"), 2) = "KV" Then Msg = True
  4.                     '在M欄位會出現KV的單位,需要*1000
  5.                 Msg = Val(Split(Cells(i, "M"), "/")(1)) * IIf(Msg = True, 1000, 1) * 0.6 > Cells(i, "Q")
  6.             Case "R"
  7.                 Msg = Split(Cells(i, "P"), "_")   'Msg = P欄中用 "_" 字串分割傳回的陣列
  8.                 If UBound(Msg) = 0 Then           '陣列元素只有一個,P欄中沒有"_"的字元
  9.                     Msg = Split(Cells(i, "P"), "_")(0)
  10.                 ElseIf UBound(Msg) > 0 Then        'P欄中有"_"的字元
  11.                     Msg = Split(Cells(i, "P"), "_")(UBound(Split(Cells(i, "P"), "_")))
  12.                     If Mid(UCase(Msg), 1, 1) = "H" Then
  13.                       '"r0603_hxx"(xx是變數) : r+後四碼字串_hxx
  14.                         Msg = Split(Cells(i, "P"), "_")(UBound(Split(Cells(i, "P"), "_")) - 1)
  15.                     Else
  16.                         Msg = Split(Cells(i, "P"), "_")(UBound(Split(Cells(i, "P"), "_")))
  17.                     End If
  18.                 End If
  19.                 W = 0
  20.                 Select Case Right(Trim(Msg), 4)  ' P欄後4碼字串
複製代碼
作者: happycoccolin    時間: 2015-1-5 15:49

回復 18# GBKEE


    謝謝版大!!!

立馬測試中~
作者: happycoccolin    時間: 2015-1-20 17:04

本帖最後由 happycoccolin 於 2015-1-20 17:06 編輯

回復 18# GBKEE


    版大~請問一下目前我run過,發現0hm部分都會顯示FAIL,但是我們裡面已經有寫到此段了,請問應如何修改呢?謝謝~

『0ohm』：ohm類的字元前面可能帶空格,部分未帶空格

IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1< W參閱項目2*0.6,PASS,FAIL)))
例如:W需要判斷P1只要有出現0402字元就= 0.0625 最下面有一對應表格
IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1<0.0625*0.6,PASS,FAIL)))

Case "R"
                Msg = Split(Cells(i, "P"), "_")   'Msg = P欄中用 "_" 字串分割傳回的陣列
                If UBound(Msg) = 0 Then           '陣列元素只有一個,P欄中沒有"_"的字元
                    Msg = Split(Cells(i, "P"), "_")(0)
                ElseIf UBound(Msg) > 0 Then        'P欄中有"_"的字元
                    Msg = Split(Cells(i, "P"), "_")(1)
                    If Mid(UCase(Msg), 1, 1) = "H" Then
                      '"r0603_hxx"(xx是變數) : r+後四碼字串_hxx
                        Msg = Split(Cells(i, "P"), "_")(0)
                    End If
                End If
                W = 0
                Select Case Right(Trim(Msg), 4)  ' P欄後4碼字串
                    Case "0402"           '零件大小
                        W = 0.0625        '功率(W)
                    Case "0603"
                        W = 0.1
                    Case "0805"
                        W = 0.125
                    Case "1206"
                        W = 0.25
                    Case "1210"
                        W = 0.3333
                    Case "1812"
                        W = 0.5
                    Case "2010"
                        W = 0.75
                    Case "2512"
                        W = 1
                End Select
                '**********************************************************************
                '4.以下這段,若是Kohm & Mohm中間帶一個空格(K ohm & M ohm),一樣可以判斷出來嗎?
                '**************************************************************************
                Msg = UCase(Right(Trim(Cells(i, "M")), 5))
               
                If Msg = "K OHM" Or Msg = "M OHM" Then   '讀取5個字元,取得歐姆單位
                    'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
                    '例如:M1=2.64Kohm=2.64*1000=2640
                     M = Val(Cells(i, "M")) * 10000        'Kohm
                    If Msg = "M OHM" Then M = Val(Cells(i, "M")) * 1000000
                    'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))
                    Msg = Cells(i, "Q") ^ 2 / M - M * Cells(i, "N") < W * 0.6
                End If
               
                If Not IsNumeric(Msg) Then                      '5個字元,非歐姆單位
                    Msg = UCase(Right(Trim(Cells(i, "M")), 4))  '讀取4個字元,取得歐姆單位
                    If Msg = "0OHM" Or Msg = " OHM" Then  '『非0 ohm』：ohm類的字元前面可能帶空格,部分未帶空格
                        'IF(O1="R",IF(OR((M1="0ohm"),(M1="0 ohm")),IF(Q1平方*N1< W參閱項目2*0.6,PASS,FAIL)))
                        M = Val(Cells(i, "M"))
                        Msg = Cells(i, "Q") ^ 2 * Cells(i, "N") < W * 0.6
                    ElseIf Msg = "KOHM" Or Msg = "MOHM" Then
                        'M1需判斷值:以歐姆值計算.若為Kohm：其值×1000、若為Mohm：其值×1000000)
                        '例如:M1=2.64Kohm=2.64*1000=2640
                        M = Val(Cells(i, "M")) * 10000        'Kohm
                        If Msg = "MOHM" Then M = Val(Cells(i, "M")) * 1000000
                        'IF(O1="R",IF(OR((M1<>"0ohm"),(M1<>"0 ohm")),IF(Q1平方/2640-2640*N1<0.0625*0.6,PASS,FAIL)))
                        Msg = Cells(i, "Q") ^ 2 / M - M * Cells(i, "N") < W * 0.6
                    End If
                End If
                If Not IsNumeric(Msg) Then                  '4個字元,非歐姆單位
                    Msg = UCase(Right(Trim(Cells(i, "M")), 3))  '剩下3個字元,最小的歐姆單位
                    M = Val(Cells(i, "M"))
                    Msg = Cells(i, "Q") ^ 2 * Cells(i, "N") < W * 0.6
               
                End If

這是執行出來的結果
[attach]20105[/attach]
語法
[attach]20104[/attach]

再拜託版大指導,謝謝~~~拜託~~
作者: happycoccolin    時間: 2015-1-20 17:05

本帖最後由 happycoccolin 於 2015-1-20 17:08 編輯

回復 20# happycoccolin

抱歉多餘檔案已刪除



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)