oobird

½Ðª`·N³o­Ó
If Application.CountA(Rows(a.Row)) = 1 Then    'a:eÄæ¤w¦³¼g¤J¸ê®Æ´N¸õ¹L
³o¦æ­­¨î¤F¥u¦³FÄ榳¼Æ¾Ú¤~°õ¦æ¡AA~E¤£­n¦³¥ô¦óªF¦è¡C

PJChen

¦^´_ 31# oobird

¦Ñ¤j,
§Ú­«·sRUN¤@¦¸,¦³¤T­ÓÀÉ®×·|¥X¿ù,§Ú¤W¶Ç¤F.¦A³Â·Ð±z!
VBA TEST 5-answer 5.zip (120.16 KB)

¤U¸ü¦¸¼Æ: 4

2012-5-18 12:05

oobird

PO¤u§@ªíªí¦W¦³°ÝÃD¡A­«·s©R¦W´N¥i¥H¤F
¤]³\¦h¤FªÅ¥Õ®æ¡A¤]³\¬O¥þ«¬ªº§Ú¨S«Üª`·N¡C VBA TEST 5-answer 5.rar (122.42 KB)

¤U¸ü¦¸¼Æ: 3

2012-5-18 12:36

PJChen

¦^´_ 28# Hsieh
¤j¤H,
¥H¤Uªºµ{¦¡°õ¦æ®É,­Yµo²{¸ê®Æ¦³³sµ²,·|¤@ª½¥X²{¹ï¸Ü®Ø,¥i¥HÅý¥¦¦Û¿ï¾Ü¤£§ó·s¦ÓÄ~Äò°õ¦æ¶Ü?

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 & "\" & "2011 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

Hsieh

¦^´_ 34# PJChen

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 & "\" & "2011 PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(Filename:=fd & fs, UpdateLinks:=False)
   
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

¦^´_ 33# oobird
¦Ñ¤j,
§Ú±N¥h¦~ªºPI/PO®³¨Ó´ú¸Õ,µo²{ÁÙ¬O·|¤@ª½¥X²{¹ï¸Ü®Ø,¸ß°Ý¬O§_§ó·s³sµ², ÁöµMµ{¦¡¤¤¦³³o¥y¸Ü Application.DisplayAlerts = False

1. Sub get_value_F()
   
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 & "\2011 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

¦^´_ 35# Hsieh
¤j¤H,

¸ß°Ý§ó·sªº¹ï¸Ü®Ø¤£¦A¥X²{¤F,¦ý¥X²{¤F·sªº¹ï¸Ü®Ø¦p¤U,§Ú±N´X­ÓÀɮפW¶Ç,³Â·Ð§A.

¤U¸ü (12.2 KB)

2012-5-18 14:40

VBA TEST 5-answer 4_Hsieh.zip (127.44 KB)

¤U¸ü¦¸¼Æ: 7

2012-5-18 14:45

oobird

³o´X­ÓÀɮתº°ÝÃD¬O¨âÄæ³£¦³"TOTAL"
For Each c In .Range("A:B").SpecialCells(xlCellTypeConstants)
§ï¦¨ For Each c In .Range("A:A").SpecialCells(xlCellTypeConstants)
ÁÙ¬O¦Ñ°ÝÃD¡ABÄæ¤]¦³"TOTAL",¦Ó¥B¦b«e­±¡A¾É­P¿ù»~§PÂ_
§ï¦¨¥u¦bAÄæ´M§ä, ¦ý©p­n«Oµý"TOTAL"¬O¦bAÄæ
¦Ü©óÁÙ¬O·|¥X²{¹ï¸Ü¤è¶ôªº°ÝÃD¡A¨S¹ê»Ú¸I¨ì¤£ª¾¬O¤°»ò±¡ªp¡C

PJChen

¦^´_ 38# oobird
¦^´_ 35# Hsieh
¦Ñ¤j,½Ð°Ý§A¬O§_¦^µª§Ú²Ä37¼Óªº°ÝÃD?­Y¬Oªº¸Ü:
Âk¨s°_¨Ó¬OÀɮפӦh¤£¦P®æ¦¡©Ò³y¦¨ªº°ÝÃD,­Y¬OTOTALªº°ÝÃD,§Ú·Q«Ü¦hÄæ¦ì³£·|¥Î³o­Ó¦r,­Y§Ú²Î¤@¥u±Ä¥Î"TOTAL:"(¬O¦³«_¸¹ªº),«h¥H¤U³o2­Óµ{¦¡¤W§ÚÀ³¸Ó¦p¦ó­×§ï?¸Ó¥¦¥u¦b¬Ý¨ì"TOTAL:"ªº±¡§Î¤U¤~§@°Ê§@?(¤G­Óµ{¦¡¦U¦³¥¦¦n¥Î¥Îªº¦a¤è,§Ú³£·Q­×§ï¥¦)

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 & "\" & "2011 PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(Filename:=fd & fs, UpdateLinks:=False)
   
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

1. Sub get_value_F()
   
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 & "\2011 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

¦^´_ 39# PJChen
¤@¦C¤¤¦P®É¦s¦bTOTAL»PPCS§@¬°§PÂ_¼Ð·Ç

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(Filename:=fd & fs, UpdateLinks:=False)
   
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.       ay = .UsedRange.Value
    
17.       For i = 1 To UBound(ay)
    
18.          mystr = UCase(Join(Application.Index(ay, i)))
    
19.          If InStr(mystr, "TOTAL") > 0 And InStr(mystr, "PCS") > 0 Then
    
20.             For j = 1 To UBound(ay, 2)
    
21.                If ay(i, j) = "PCS" Then d(Trim(.Name) & "¼Æ¶q") = ay(i, j - 1): yn = True
    
22.                If IsNumeric(ay(i, j)) And yn = True Then d(Trim(.Name) & "ª÷ÃB") = ay(i, j): yn = False: Exit For
    
23.             Next
    
24.          End If
    
25.       Next
    
26. 20
    
27.       End With
    
28. 10
    
29.     Next
    
30.     ReDim Preserve Ar(y)
    
31.     Ar(y) = Array(fn, d("PI¼Æ¶q"), d("PIª÷ÃB"), d("PO¼Æ¶q"), d("POª÷ÃB"), fs)
    
32.     y = y + 1
    
33.     .Close
    
34.     d.RemoveAll
    
35. End With
    
36. fs = Dir
    
37. Loop
    
38. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
39. Application.ScreenUpdating = True
    
40. Application.DisplayAlerts = True
    
41. End Sub

½Æ»s¥N½X