Hsieh

¦^´_ 20# PJChen

¨º¬O¦]¬°§Aªº¤u§@ªí¤£¥u¬O¥u¦³PI¸òPO
³y¦¨TOTAL¨º¤@¦æ§ä¤£¨ìpcs©Ò­P

1. Sub ex()
   
2. Dim Sh As Worksheet, A As Range, Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. fd = ThisWorkbook.Path & "\" & "PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(fd & fs)
   
10. n = Split(fs, " ")(0)
    
11. s = InStr(n, "BCM") + 3
    
12. fn = Mid(n, s)
    
13.    For Each Sh In .Sheets
    
14.       With Sh
    
15.       If .Name <> "PO" Or .Name <> "PI" Then GoTo 10
    
16.       For Each C In .Range("A:B").SpecialCells(xlCellTypeConstants)
    
17.         If C Like "TOTAL*" Then Set A = C: Exit For
    
18.       Next
    
19.       If Not A Is Nothing Then
    
20.       Set b = A.EntireRow.Find("pcs")
    
21.       If Not b Is Nothing Then
    
22.         d(.Name & "¼Æ¶q") = b.Offset(, -1)
    
23.         d(.Name & "ª÷ÃB") = b.Offset(, 2)
    
24.       End With
    
25.       End If
    
26.       End With
    
27. 10
    
28.     Next
    
29.     ReDim Preserve Ar(y)
    
30.     Ar(y) = Array(fn, d("PI¼Æ¶q"), d("PIª÷ÃB"), d("PO¼Æ¶q"), d("POª÷ÃB"), fs)
    
31.     y = y + 1
    
32.     .Close
    
33.     d.RemoveAll
    
34. End With
    
35. fs = Dir
    
36. Loop
    
37. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
38. Application.ScreenUpdating = True
    
39. Application.DisplayAlerts = True
    
40. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 21# Hsieh
ª©¤j,
³o­Óµ{¦¡¥X²{¤@­Ó¹ï¸Ü®Ø

¤U¸ü (13.4 KB)

2012-5-17 16:30

§Ú¸ÕµÛ¥h§ïEnd Withªº¦ì¸m,¦ýÁÙ¬OµLªk°õ¦æ,½Ð¦AÀ°¦£¬Ý¬Ý!

PJChen

¦^´_ 19# PJChen
¦Ñ¤j,
¸É¥R: §Ú¸ÕµÛ¦Û¤vkey§¹¾ãªºÀɦW¦bFÄæ,µM«á±N2012¦~ªºbcmÀɮשñ¦b"2012 PI_PO"¸ê®Æ§¨¤¤(¦]¬°¦~«×«Ü¦h,©Èrun¤Ó¤[),µM«á­×§ïµ{¦¡¦p¤U,¦ý§¹¥þ¤£¯à°Ê§@!

1. Sub get_value()
   
2.     Dim a As Range, arr(1 To 5)
   
3.     Application.ScreenUpdating = False    'Ãö³¬¿Ã¹õ°{Ã{
   
4.     For Each a In Range([f2], [f2].End(4))    '¦bf2¥H¤Uªº¸ê®Æ½d³ò´`Àô
   
5.         If Application.CountA(Rows(a.Row)) = 1 Then    'a:eÄæ¤w¦³¼g¤J¸ê®Æ´N¸õ¹L
   
6.             Application.DisplayAlerts = False    'Ãö³¬¶}±Ò®Éªº¹ï¸Ü¤è¶ô
   
7.             fb = ThisWorkbook.Path & "\2012 PI_PO\" & a    '±q"PI_PO¸ê®Æ§¨"¨ú¸ô®|
   
8.             Set wk = GetObject(fb)    '­I´º¶}±Ò¸Ó¸ô®|ÀÉ®×
   
9.             Sh = Array("PI", "PO")    '¨â­Ó¤u§@ªí¦W
   
10.             On Error Resume Next    '²¤¹L¿ù»~
    
11.             For s = 0 To 1
    
12.                 Set mysheet = wk.Sheets(Sh(s))    '¤u§@ªíÅܶq
    
13.                 If Err.Number = 0 Then    '¦p¤£µo¥Í¿ù»~(¦³³o­Ó¤u§@ªí)
    
14.                 mysheet.AutoFilterMode = False '¨ú®ø¿z¿ï
    
15.                     mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole    '§â±a¤À¸¹ªºTOTAL§ï¦¨¤£±a¤À¸¹
    
16.                     r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row            '¦bAB¨âÄæ´M§ä"TOTAL"
    
17.                     c = mysheet.Cells(r, 15).End(1).Column    '¨úTOTAL¨º¤@¦æªº³Ì¥kÄæ(§Yª÷ÃB)
    
18.                     arr(1) = Split(a, " ")(0) '¨úfÄæ²Ä¤@­ÓªÅ®æ¥H«eªº¦r¦ê
    
19.                     arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value    '¨ú³Ì¥kÄæ´î3Ä檺¼Æ¦r
    
20.                     arr(s * 2 + 3) = mysheet.Cells(r, c).Value    '¨ú³Ì¥kÄ檺¼Æ¦r
    
21.                 End If
    
22.                 Err.Clear    '²M°£¿ù»~
    
23.             Next
    
24.            Cells(a.Row, 1).Resize(1, 5) = arr   '¼g¤JÀx¦s®æ
    
25.             Erase arr
    
26.             wk.Close 0            'Ãö³¬¥´¶}ªºÀɮפ£Àx¦s
    
27.         End If
    
28.     Next
    
29. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 22# PJChen

1. Sub ex()
   
2. Dim Sh As Worksheet, A As Range, Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. fd = ThisWorkbook.Path & "\" & "PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(fd & fs)
   
10. n = Split(fs, " ")(0)
    
11. s = InStr(n, "BCM") + 3
    
12. fn = Mid(n, s)
    
13.    For Each Sh In .Sheets
    
14.       With Sh
    
15.       If .Name <> "PO" Or .Name <> "PI" Then GoTo 10
    
16.       For Each C In .Range("A:B").SpecialCells(xlCellTypeConstants)
    
17.         If C Like "TOTAL*" Then Set A = C: Exit For
    
18.       Next
    
19.       If Not A Is Nothing Then
    
20.       Set b = A.EntireRow.Find("pcs")
    
21.       If Not b Is Nothing Then
    
22.         d(.Name & "¼Æ¶q") = b.Offset(, -1)
    
23.         d(.Name & "ª÷ÃB") = b.Offset(, 2)
    
24.       End If
    
25.       End If
    
26.       End With
    
27. 10
    
28.     Next
    
29.     ReDim Preserve Ar(y)
    
30.     Ar(y) = Array(fn, d("PI¼Æ¶q"), d("PIª÷ÃB"), d("PO¼Æ¶q"), d("POª÷ÃB"), fs)
    
31.     y = y + 1
    
32.     .Close
    
33.     d.RemoveAll
    
34. End With
    
35. fs = Dir
    
36. Loop
    
37. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
38. Application.ScreenUpdating = True
    
39. Application.DisplayAlerts = True
    
40. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 24# Hsieh
VBA TEST 5-answer 4_Hsieh.zip (213.25 KB)

¤U¸ü¦¸¼Æ: 3

2012-5-17 20:58

Dear ¤j¤H,

§Ú±N±z­×¥¿ªºµ{¦¡Run¹L«á,¦³¥H¤U°ÝÃD,
1)  §Ú±N­ìÀɦW¦Ukey-in¦ba¤ÎfÄæ,¦]¬°«e­±oobird´£¹L§¹¾ãªºÀɦW¤ñ¸û®e©ö§ì¸ê®Æ,©Ò¥H§Ú´N³o»ò§@.
2)  Run§¹µ{¦¡«á,¥¦¥u§âAÄ檺§¹¾ãÀɦW­×§ï¬°§Ú­ì¥ý³ÌªìªºBCM no.,¨ä¾lÄæ¦ì§¹¥þ¥¼¶ñ¤J¼Æ­È.
3)  §Ú±NRun§¹ªºµ²ªG¤W¶Ç¤F,­n³Â·Ð±zÀ°§Ú¬Ý¤@¤U,§Ú¤£ª¾¹Dµo¥Í¤F¤°»ò¨Æ?
ÁÂÁ±z!

Hsieh

¦^´_ 25# PJChen
±ø¥óÀ³¸Ó¬OAND¤~¹ï
If .Name <> "PO" And .Name <> "PI" Then GoTo 10
¾ã­Óµ{¦¡½X´N¬O¦Û°Ê±NÀɦW¤Á³Î¥X½s¸¹A¡BFÄ椣»Ý¶ñ¼g¡A°õ¦æ§¹´N·|¨q¥X¨Ó¤F

1. Sub get_value()
   
2. Dim Sh As Worksheet, A As Range, Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. fd = ThisWorkbook.Path & "\" & "PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(fd & fs)
   
10. n = Split(fs, " ")(0)
    
11. s = InStr(n, "BCM") + 3
    
12. fn = Mid(n, s)
    
13.    For Each Sh In .Sheets
    
14.       With Sh
    
15.       If .Name <> "PO" And .Name <> "PI" Then GoTo 10
    
16.       For Each C In .Range("A:B").SpecialCells(xlCellTypeConstants)
    
17.         If C Like "TOTAL*" Then Set A = C: Exit For
    
18.       Next
    
19.       If Not A Is Nothing Then
    
20.       Set b = A.EntireRow.Find("pcs")
    
21.       If Not b Is Nothing Then
    
22.         d(.Name & "¼Æ¶q") = b.Offset(, -1)
    
23.         d(.Name & "ª÷ÃB") = b.Offset(, 2)
    
24.       End If
    
25.       End If
    
26.       End With
    
27. 10
    
28.     Next
    
29.     ReDim Preserve Ar(y)
    
30.     Ar(y) = Array(fn, d("PI¼Æ¶q"), d("PIª÷ÃB"), d("PO¼Æ¶q"), d("POª÷ÃB"), fs)
    
31.     y = y + 1
    
32.     .Close
    
33.     d.RemoveAll
    
34. End With
    
35. fs = Dir
    
36. Loop
    
37. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
38. Application.ScreenUpdating = True
    
39. Application.DisplayAlerts = True
    
40. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 26# Hsieh
¦Ñ¤j,

VBA TEST 5-answer 4.zip (351.94 KB)

¤U¸ü¦¸¼Æ: 3

2012-5-17 22:16

PI_PO Records¶À¦â©³ªº³¡¥÷µLªk¶ñ¤J¼Æ­È,§Ú²q·Q¥i¯à¬O®æ¦¡¤£¬Û¦Pªº°ÝÃD?¦]¬°¨C­Ó¤Hªº¤u§@ªí®æ¦¡³£¤£¦P,¦³±o±Ï¶Ü?

Hsieh

¦^´_ 27# PJChen

¤u§@ªí¦WºÙ¤£²Å¦h¤FªÅ¥ÕÁä

1. Sub get_value()
   
2. Dim Sh As Worksheet, A As Range, Ar(), B As Range, B1 As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. fd = ThisWorkbook.Path & "\" & "PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(fd & fs)
   
10. n = Split(fs, " ")(0)
    
11. s = InStr(n, "BCM") + 3
    
12. fn = Mid(n, s)
    
13.    For Each Sh In .Sheets
    
14.       With Sh
    
15.       If Trim(.Name) <> "PO" And Trim(.Name) <> "PI" Then GoTo 10
    
16.       For Each C In .Range("A:B").SpecialCells(xlCellTypeConstants)
    
17.         If C Like "TOTAL*" Then Set A = C: Exit For
    
18.       Next
    
19.       If Not A Is Nothing Then
    
20.       Set B = A.EntireRow.Find("pcs")
    
21.       Set B1 = A.EntireRow.Find("*", after:=B)
    
22.       
    
23.       If Not B Is Nothing Then
    
24.         d(Trim(.Name) & "¼Æ¶q") = B.Offset(, -1)
    
25.         c1 = A.EntireRow.Find("*", after:=B1)
    
26.         d(Trim(.Name) & "ª÷ÃB") = c1
    
27.       End If
    
28.       End If
    
29.       Set A = Nothing
    
30.       End With
    
31. 10
    
32.     Next
    
33.     ReDim Preserve Ar(y)
    
34.     Ar(y) = Array(fn, d("PI¼Æ¶q"), d("PIª÷ÃB"), d("PO¼Æ¶q"), d("POª÷ÃB"), fs)
    
35.     y = y + 1
    
36.     .Close
    
37.     d.RemoveAll
    
38. End With
    
39. fs = Dir
    
40. Loop
    
41. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
42. Application.ScreenUpdating = True
    
43. Application.DisplayAlerts = True
    
44. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 18# oobird
¦Ñ¤j,¤£¦n·N«ä³o¬O¦^Âе¹§Aªº,§Ú«ö¿ù¼Ó¼h,§Ú·Q§AÀ³¸Ó¨S¦¬¨ì,§Ú±N«e2¦¸°µ­Ó¾ã²z.
1) §Ú¥ý¸Õ¤F§ì¨úFÄæfile nameªº¥¨¶°,µo²{¥¦¥u·|±N©Ò¦³ÀɦW§ì¶i¨Ó¦Ó¤£·|¤ñ¹ï.
2) §Ú¸ÕµÛ¦Û¤vkey§¹¾ãªºÀɦW¦bFÄæ,µM«á±N2012¦~ªºbcmÀɮשñ¦b"2012 PI_PO"¸ê®Æ§¨¤¤(¦]¬°¦~«×«Ü¦h,©Èrun¤Ó¤[),µM«á­×§ïµ{¦¡¦p¤U,¦ý§¹¥þ¤£¯à°Ê§@!

1. Sub get_value()
   
2.     Dim a As Range, arr(1 To 5)
   
3.     Application.ScreenUpdating = False    'Ãö³¬¿Ã¹õ°{Ã{
   
4.     For Each a In Range([f2], [f2].End(4))    '¦bf2¥H¤Uªº¸ê®Æ½d³ò´`Àô
   
5.         If Application.CountA(Rows(a.Row)) = 1 Then    'a:eÄæ¤w¦³¼g¤J¸ê®Æ´N¸õ¹L
   
6.             Application.DisplayAlerts = False    'Ãö³¬¶}±Ò®Éªº¹ï¸Ü¤è¶ô
   
7.             fb = ThisWorkbook.Path & "\2012 PI_PO\" & a    '±q"PI_PO¸ê®Æ§¨"¨ú¸ô®|
   
8.             Set wk = GetObject(fb)    '­I´º¶}±Ò¸Ó¸ô®|ÀÉ®×
   
9.             Sh = Array("PI", "PO")    '¨â­Ó¤u§@ªí¦W
   
10.             On Error Resume Next    '²¤¹L¿ù»~
    
11.             For s = 0 To 1
    
12.                 Set mysheet = wk.Sheets(Sh(s))    '¤u§@ªíÅܶq
    
13.                 If Err.Number = 0 Then    '¦p¤£µo¥Í¿ù»~(¦³³o­Ó¤u§@ªí)
    
14.                 mysheet.AutoFilterMode = False '¨ú®ø¿z¿ï
    
15.                     mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole    '§â±a¤À¸¹ªºTOTAL§ï¦¨¤£±a¤À¸¹
    
16.                     r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row            '¦bAB¨âÄæ´M§ä"TOTAL"
    
17.                     c = mysheet.Cells(r, 15).End(1).Column    '¨úTOTAL¨º¤@¦æªº³Ì¥kÄæ(§Yª÷ÃB)
    
18.                     arr(1) = Split(a, " ")(0) '¨úfÄæ²Ä¤@­ÓªÅ®æ¥H«eªº¦r¦ê
    
19.                     arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value    '¨ú³Ì¥kÄæ´î3Ä檺¼Æ¦r
    
20.                     arr(s * 2 + 3) = mysheet.Cells(r, c).Value    '¨ú³Ì¥kÄ檺¼Æ¦r
    
21.                 End If
    
22.                 Err.Clear    '²M°£¿ù»~
    
23.             Next
    
24.            Cells(a.Row, 1).Resize(1, 5) = arr   '¼g¤JÀx¦s®æ
    
25.             Erase arr
    
26.             wk.Close 0            'Ãö³¬¥´¶}ªºÀɮפ£Àx¦s
    
27.         End If
    
28.     Next
    
29. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 28# Hsieh
ª©¤j,
§ï¦¨³o¼Ë¥Ø«eµLªk°õ¦æ, ¥X²{¤F³o¼Ëªº°T®§:

¤U¸ü (12.75 KB)

2012-5-18 10:37