GBKEE

¦^´_ 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:="½Ð¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
   
6.      If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
   
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.­Y¬OOÄæ(Implementation)¬°ªÅ,½Ð¦bSÄæ¦ì(µ²ªGÄæ¦ì)Åã¥Ü"µL¤u§@¹qÀ£/¹q¬y"
    
19.                 Msg = "µL¤u§@¹qÀ£/¹q¬y"
    
20.             Case "C"
    
21.                 'IF(O1="C",IF(¡yÂ^¨úM1Äæ"/"«á¦r¤¸¡z*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Ä椤¥Î "_" ¦r¦ê¤À³Î¶Ç¦^ªº°}¦C
    
25.                 If UBound(Msg) = 0 Then           '°}¦C¤¸¯À¥u¦³¤@­Ó,PÄ椤¨S¦³"_"ªº¦r¤¸
    
26.                     Msg = Split(Cells(i, "P"), "_")(0)
    
27.                 ElseIf UBound(Msg) > 0 Then        'PÄ椤¦³"_"ªº¦r¤¸
    
28.                     Msg = Split(Cells(i, "P"), "_")(1)
    
29.                     If Mid(UCase(Msg), 1, 1) = "H" Then
    
30.                       '"r0603_hxx"(xx¬OÅܼÆ) : r+«á¥|½X¦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½X¦r¦ê
    
36.                     Case "0402"           '¹s¥ó¤j¤p
    
37.                         W = 0.0625        '¥\²v(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.¥H¤U³o¬q,­Y¬OKohm & Mohm¤¤¶¡±a¤@­ÓªÅ®æ(K ohm & M ohm),¤@¼Ë¥i¥H§PÂ_¥X¨Ó¶Ü?
    
55.                 '**************************************************************************
    
56.                 Msg = UCase(Right(Trim(Cells(i, "M")), 5))
    
57.                
    
58.                 If Msg = "K OHM" Or Msg = "M OHM" Then   'Ū¨ú5­Ó¦r¤¸,¨ú±o¼Ú©i³æ¦ì
    
59.                     'M1»Ý§PÂ_­È:¥H¼Ú©i­È­pºâ.­Y¬°Kohm¡G¨ä­È¡Ñ1000¡B­Y¬°Mohm¡G¨ä­È¡Ñ1000000)
    
60.                     '¨Ò¦p: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­Ó¦r¤¸,«D¼Ú©i³æ¦ì
    
68.                     Msg = UCase(Right(Trim(Cells(i, "M")), 4))  'Ū¨ú4­Ó¦r¤¸,¨ú±o¼Ú©i³æ¦ì
    
69.                     If Msg = "0OHM" Or Msg = " OHM" Then  '¡y«D0 ohm¡z¡GohmÃþªº¦r¤¸«e­±¥i¯à±aªÅ®æ,³¡¤À¥¼±aªÅ®æ
    
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»Ý§PÂ_­È:¥H¼Ú©i­È­pºâ.­Y¬°Kohm¡G¨ä­È¡Ñ1000¡B­Y¬°Mohm¡G¨ä­È¡Ñ1000000)
    
75.                         '¨Ò¦p: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­Ó¦r¤¸,«D¼Ú©i³æ¦ì
    
83.                     Msg = UCase(Right(Trim(Cells(i, "M")), 3))  '³Ñ¤U3­Ó¦r¤¸,³Ì¤pªº¼Ú©i³æ¦ì
    
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¥­¤è<¡y§PÂ_F1Ä桨/¡¨«á¦r¤¸,­Y¥X²{mA¦r¤¸,¨ä­È­n¡Ò1000¤Ï¤§«h§_¡z¥­¤è*0.6,PASS,FAIL)))
    
90.                 '¨Ò¦p:F1­È=FERRITE BEAD(0402)600OHM/300mA,«h°õ¦æ¡¨/¡¨«á¦r¤¸=300mA=300/1000
    
91.                 'IF(O1="Bead",IF(Q1¥­¤è<0.3¥­¤è*0.6,PASS,FAIL)))
    
92.                 If InStr(Cells(i, "f"), "/") Then   '§PÂ_F1Äæ ¦³¡¨/¡¨¦¹¦r¤¸
    
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 = "µL¤u§@¹qÀ£/¹q¬y" 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Åã¥Üºñ©³¶Â¦r FAILÅã¥Ü¬õ©³¥Õ¦r
     
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.§Ú¥Ø«e¬O·Q°µ¦¨§Ú¥i¥H°õ¦æ¦¹µ{¦¡«á¸õ¥X¤@­Óµøµ¡->Åý§Ú¬D¿ï­n¸ü¤JªºÀÉ®×->¸ü¤J«á°õ¦æ¹Bºâ->¸õ¥Xµøµ¡Åý§Ú¥i¥t¦s·sÀÉ~
     
125.    If MsgBox("½Ð°Ý¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
     
126.         fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
     
127.         If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
     
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
     
137. 
     
138.     '******************************
     
139.     '1¤£­n±Nµ²ªGÅã¥Ü¦b­ìÀÉ®×
     
140.     Sh.Parent.Close False
     
141.    
     
142. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# happycoccolin
3#µ{¦¡½X¤w§ó·s,½Ð¸Õ¸Õ¬Ý.
3.¥t¥~,­Y¬O°w¹ï"R"ªº³¡¤À,¦bPÄæ·|¥X²{"r0603_hxx"(xx¬OÅܼÆ) or "r0603"ªº¦r¤¸,¤@¼Ë¥i¥H§PÂ_¥X¨Ó¶Ü?(­ì¥ý¬O¹w³]¬°:mx_r0603)
½Ð¥X¥Ü PÄæ©Ò¦³­n³B¸Ìªº¦r¦ê¤¸½d¨Ò

GBKEE

¦^´_ 8# happycoccolin
¥i¥H¸ÕµÛ®M¤W¥Î,¤£¦æ¥i¦A´£°Ý.

GBKEE

¦^´_ 10# happycoccolin
¿ù»~½Ð°Ñ¦Ò http://forum.twbts.com/viewthread.php?tid=6733

1.   '**********************************************************
   
2.     '1.§Ú¥Ø«e¬O·Q°µ¦¨§Ú¥i¥H°õ¦æ¦¹µ{¦¡«á¸õ¥X¤@­Óµøµ¡->Åý§Ú¬D¿ï­n¸ü¤JªºÀÉ®×->¸ü¤J«á°õ¦æ¹Bºâ->¸õ¥Xµøµ¡Åý§Ú¥i¥t¦s·sÀÉ~
   
3.    If MsgBox("½Ð°Ý¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
   
4.         fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
   
5.         If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
   
6.         SH.Copy
   
7.         With ActiveWorkbook
   
8.             .SaveAs fileout ', FileFormat:=xlWorkbookDefault
   
9.             .Close True
   
10.         End With
    
11.       
    
12.     End If
    
13. 
    
14.     '******************************
    
15.     '1¤£­n±Nµ²ªGÅã¥Ü¦b­ìÀÉ®×
    
16.     SH.Parent.Close False
    
17.   

½Æ»s¥N½X

GBKEE

¦^´_ 15# happycoccolin
¼g¤£¥Xµ²ªG¨SÃö«Y,PO¤W©p©Ò¼gªº,¬Ý¬Ý¦p¦ó§ï.

GBKEE

¦^´_ 17# happycoccolin
½Ð­×§ï ¬Ý¬Ý

1. Case "C"
   
2.                 'IF(O1="C",IF(¡yÂ^¨úM1Äæ"/"«á¦r¤¸¡z*0.6>Q1,PASS,FAIL))
   
3.                 If Right(Cells(i, "M"), 2) = "KV" Then Msg = True
   
4.                     '¦bMÄæ¦ì·|¥X²{KVªº³æ¦ì,»Ý­n*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Ä椤¥Î "_" ¦r¦ê¤À³Î¶Ç¦^ªº°}¦C
   
8.                 If UBound(Msg) = 0 Then           '°}¦C¤¸¯À¥u¦³¤@­Ó,PÄ椤¨S¦³"_"ªº¦r¤¸
   
9.                     Msg = Split(Cells(i, "P"), "_")(0)
   
10.                 ElseIf UBound(Msg) > 0 Then        'PÄ椤¦³"_"ªº¦r¤¸
    
11.                     Msg = Split(Cells(i, "P"), "_")(UBound(Split(Cells(i, "P"), "_")))
    
12.                     If Mid(UCase(Msg), 1, 1) = "H" Then
    
13.                       '"r0603_hxx"(xx¬OÅܼÆ) : r+«á¥|½X¦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½X¦r¦ê

½Æ»s¥N½X