ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°ÝVBA ªºµ{¦¡¦³¨S¦³¥i¥H¿ë»{¬Y­ÓÀx¦s®æ¤ºªº¦r¤¸¦³µL¥]§t¬Y´X­Ó¦r¦ê¡H

¦^´_ 10# 198188


    ¤j¤j±z¼gªº¦nªø....
    ±N¨â­Ó¬¡­¶Ã¯¦X¨Ö¦¨¤@­ÓÀɮקPÂ_.. (¼gªk©M ¨â­Ó¬¡­¶Ã¯¤À¶}ªº¼gªk®t¤£¦h)
   ®Ú¾Ú±z©Òµo°Ýªº°ÝÃD¡A¥H²©öªºµ{¦¡§PÂ_..

st1 = ¤u§@ªí1.Range("a2").CurrentRegion.Rows.Count
st2 = ¤u§@ªí2.Range("d2").CurrentRegion.Rows.Count

For k1 = 2 To st1
    For k2 = 2 To 233
        If ¤u§@ªí2.Cells(k2, "D") = ¤u§@ªí1.Cells(k1, "A") And (InStr(1, ¤u§@ªí2.Cells(k2, "H"), "OBL") >= 1) Then
         '¤u§@ªí2.Cells(k2, "c") = "¹ïÀ³¨ì" & ¤u§@ªí1.Cells(k1, "A")'¦¹¦æ¬° ¦b¤u§@ªí2 CÄæ¼Ðµù DÄæ¦ì¬O§_¦³²Å¦X ¤u§@ªí1  AÄæ¦ì
         ¤u§@ªí1.Cells(k1, "J") = ¤u§@ªí2.Cells(k2, "H")
        End If
    Next
Next

  ¦h°µ¦h·Q¦h¾Ç²ß¡A¤Ö¬Ý¤Ö¿ù¤Ö°g³~

  ¦h°µ=¦h¦h½m²ß¡A¦h¦h½s¼g¡C
  ¦h·Q=·Q·Q¬°¤°»ò¤H®aµ{¦¡­n¨º¼Ë¼g¡A¦pªG´«¦¨¦Û¤v¡A¤S·|«ç¼g¡C
  ¦h¾Ç²ß=¾Ç²ß¤H®aªºµo°Ý¨Ã¸Ñµª¡A¾Ç²ß¤H®aªº¼gªk

  ¤Ö¬Ý=¥u¬Ý¤£°µ¤]ªPµM

TOP

¦^´_ 11# mark15jill
  1. Sub State_Detail()
  2. Dim FRng As Range
  3. Dim a As Range, Rng As Range
  4. Dim i As Integer
  5. Dim LastRec As Integer
  6. Dim z As Integer
  7. Dim y As Integer
  8. Dim x As Integer
  9. Dim w As Integer

  10. z = Sheets("state").Range("a2").CurrentRegion.Rows.Count
  11. fs = "C:\Documents and Settings\USER\®à­±\DOCS RECEIVED N RELEASED RECORD.xlsx"
  12. Set WB = Workbooks.Open(fs)

  13. With ThisWorkbook.Worksheets("State")

  14. x = 2
  15. For w = 2 To z
  16.     Do
  17.         If WB.Sheets("¦¬¥ó°O¿ý").Cells(x, "D") = Sheets("state").Cells(w, "A") And (InStr(1, WB.Sheets("¦¬¥ó°O¿ý").Cells(x, "H"), "OBL") >= 1) Then
  18.                  Sheets("state").Cells(w, "J") = WB.Sheets("¦¬¥ó°O¿ý").Cells(x, "H")
  19.         End If
  20.         x = x + 1
  21.    Loop Until x = WB.Sheets("¦¬¥ó°O¿ý").Row.Count.End(xlUp)
  22. Next

  23. End With
  24. WB.Close 0
  25. End Sub
½Æ»s¥N½X
¥X²{°õ¦æ¶¥¬q¿ù»~9 °}¦C¯Á¤Þ¶W¥X½d³ò

TOP

¦^´_ 12# 198188
·|¥X²{¶W¥X°}¦C¯Á¤Þ¿ù»~¬O¦]¬°§A¦b¶}±Ò¨Ó·½ÀÉ¥H«á¡A¤@¯ë¼Ò²Õ¤ºµ{¦¡½X­Y¨S«ü©w¬¡­¶Ã¯¡A«h·|¥H·í«e§@¥Î¤¤ªº¬¡­¶Ã¯§@¬°¸Ó¬¡­¶Ã¯
³q±`§Ú·|³o»ò°µ¡A¤ñ¸û®e©ö§ä¥X¿ù»~ÂI
  1. Sub ex()
  2. Dim Sh As Worksheet, Rng As Range
  3. fd = ThisWorkbook.Path & "\"  '¸ê®Æ¨Ó·½¥Ø¿ý
  4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '¸ê®Æ¨Ó·½ÀÉ®×(§t°ÆÀɦW)
  5. With Workbooks.Open(fd & fs)
  6.   Set Sh = .Sheets("¦¬¥ó°O¿ý")
  7.       With ThisWorkbook.Sheets("State")
  8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
  9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
  10.             If Not Rng Is Nothing Then
  11.                If InStr(Rng.Offset(, 4), "OBL") > 0 Then _
  12.                A.Offset(, 9) = Rng.Offset(, 4).Value Else A.Offset(, 9) = ""
  13.             End If
  14.          Next
  15.       End With
  16.     .Close
  17. End With
  18. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 13# Hsieh


    ¦³­Ó°ÝÃD¡A¦]¬°§ÚªºDATA BASEùتº­q³æ¸¹·|­«½Æ´X¦¸¡A Set Rng = Sh.Columns("D").Find(a, lookat:=xlWhole) ³o¥y¥u¬O·|§ä¤@¦¸
¨Ò¦p¡G
200000     PLANT INV
200000     OHC
200000     OBL
200000     CO
200000     ¿ðµý«H

211111     OBL
211111     OHC
211111     CO

222222     OHC
222222     CO
222222     OBL
®ÄªG´NµLªk¥X²{
¦]¬°§Ú¬O·Q¥u­n­q³æ¸¹¬Û¦P¡A¦Ó¥B³o¨Ç­q³æ¸¹¥u­n¦³¤@¦C¦³OBL¤T­Ó¦r¡A´N¥X²{OBL§_«hªÅ®æ

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-3-9 12:52 ½s¿è

¦^´_ 14# 198188
Set Rng = Sh.Columns("D").Find(a, lookat:=xlWhole) ³o¥y¥u¬O·|§ä¤@¦¸
¦p¤U¥i´M§ä¥þ³¡
  1. Option Explicit
  2. Sub Ex()
  3.     Dim A As String, Rng As Range, Sh As Worksheet, Address_First As String
  4.     Dim M As String
  5.     Set Sh = ActiveSheet
  6.     A = "OBL"                                          '´M§äªº¦r¦ê
  7.     Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole) '²Ä¤@­Ó
  8.     If Not Rng Is Nothing Then
  9.         Address_First = Rng.Address                    '¼g¤U²Ä¤@­Ó¦ì§}
  10.         Do
  11.             M = IIf(M <> "", M & ",", "") & Rng.Address
  12.             Set Rng = Sh.Columns("D").FindNext(Rng)   'Ä~Äò´M§ä¤U¤@­Ó
  13.         Loop Until Address_First = Rng.Address        '¦^¨ì²Ä¤@­Ó¦ì§}
  14.         MsgBox M
  15.      Else
  16.         MsgBox "§ä¤£¨ì"
  17.     End If
  18. End Sub
  19. Sub Ex_1()
  20.     Dim A As String, Rng As Range, Sh As Worksheet, Address_First
  21.     Set Sh = ActiveSheet
  22.     A = "OBL"                                           '´M§äªº¦r¦ê
  23.     Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)  '²Ä¤@­Ó
  24.     If Not Rng Is Nothing Then
  25.         With Sh.Columns("D")
  26.             .Replace A, "=ABC", xlWhole                 '­×§ï"´M§äªº¦r¦ê" = ¨S©w¸qªº¦WºÙ
  27.             Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors) 'Àx¦s®æ¦³¿ù»~­Èªº¯S©w½d³ò
  28.             Rng.Value = A                                '¨S©w¸qªº¦WºÙ §ï¦^ "´M§äªº¦r¦ê"
  29.             MsgBox Rng.Address
  30.         End With
  31.     Else
  32.         MsgBox "§ä¤£¨ì"
  33.     End If
  34. End Sub
½Æ»s¥N½X
¦]¬°§Ú¬O·Q¥u­n­q³æ¸¹¬Û¦P¡A¦Ó¥B³o¨Ç­q³æ¸¹¥u­n¦³¤@¦C¦³OBL¤T­Ó¦r¡A´N¥X²{OBL§_«hªÅ®æ
¤£¤F¸Ñ§AÀɮפº®e µLªk¦^µª

TOP

¦^´_ 15# GBKEE


§Ú·Q­nªº®ÄªG¬O®Ú¾ÚTest.xlsmªºState Sheet ªºAÄ檺­q³æ¸¹¡A¨Ó´M§äDOCS RECEIVED N RELEASED RECORD.xlsx ¦¬³æ°O¿ýSHEET¤ºDÄæ¬O§_¦³¬Û¦Pªº­q³æ¸¹©MHÄ檺¦r¤¸¤º¥]§t"OBL"¤T­Ó¦r¡]¤j¤p¼g³£¨S¦³°ÝÃD¥i¥HŪ¨ì¡^¡A¦pªG¦³¡A¦bTest.xlsmªºState Sheet ªº¬ÛÀ³ªº­q³æ¸¹JÄæÅã¥ÜDOCS RECEIVED N RELEASED RECORD.xlsx ¦¬³æ°O¿ýSHEET¤ºHÄ檺¸ê®Æ¡C¦pªG¨S¦³´NªÅ®æ¡C
«e­±¦³ªþ¥ó
Test.xlsm
State sheet
AÄæ                JÄæ
20000          OBL-3
20001
20002
20003          OBL
20004          OBL

W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"
¦¬³æ°O¿ýSHEET
DÄæ                          HÄæ
20000                     ¿ðµý«H
20000                     OBL-3
20003                     OHC(BODY-1,OIE-1,ACCEPTED BSE-1),CO
20000                     OHC(BODY-1,HPAI-1)
20004                     OHC(BODY-1,OIE-1,ACCEPTED BSE-1,AD-1,CL-1)
20005                     OHC(BODY-1)
20003                     OBL
20003                     INV
20005                     INV
20005                     OBL
20004                     OBL

TOP

¦^´_ 16# 198188
  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Range, Rng As Range, E As Range
  4.     With Sheet1                         '*** ¶·§ï¬°: Test.xlsmªºState Sheet
  5.         Set R = .Cells(1, "a")          'A1¶}©l
  6.         Do Until R = ""                 'Â÷¶}°j°éªº±ø¥ó:  AÄ檺 Àx¦s®æ=""
  7.             With Sheet2                 '*** ¶·§ï¬°: W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx"
  8.                 Set Rng = .Columns("D").Find(R, lookat:=xlWhole)
  9.                  If Not Rng Is Nothing Then
  10.                     With .Columns("D")
  11.                         .Replace R, "=ABC", xlWhole                 '­×§ï"´M§äªº¦r¦ê" = ¨S©w¸qªº¦WºÙ
  12.                         Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors) 'Àx¦s®æ¦³¿ù»~­Èªº¯S©w½d³ò
  13.                         Rng.Value = R                               '¨S©w¸qªº¦WºÙ §ï¦^ "´M§äªº¦r¦ê"
  14.                         For Each E In Rng.Offset(0, 4)              'DÄæ¦ì²¾4Äæ=HÄæ
  15.                             If InStr(UCase(E), "OBL") Then          'HÄ檺¦r¤¸¤º¥]§t"OBL"¤T­Ó¦r
  16.                                                                     'UCase(E) Âà´«¬°¤j¼g
  17.                                 R.Offset(0, 9) = E.Value            'R.Offset(0, 9)-> AÄæ¦ì²¾¨ì JÄæ
  18.                                 'Test.xlsmªºState Sheet->JÄæ=DOCS RECEIVED N RELEASED RECORD.xlsx"->HÄ檺¦r¤¸
  19.                                 Exit For    '¦³§ä¨ì "OBL" Â÷¶}°j°é                          '
  20.                             End If
  21.                        Next
  22.                     End With                '.Columns("D")
  23.                 End If
  24.             End With                        'Sheet2
  25.             Set R = R.Offset(1)             '¤U²¾¨ì A2
  26.         Loop
  27.     End With                                'Sheet1
  28. End Sub
½Æ»s¥N½X

TOP

¦^´_ 14# 198188
  1. Sub ex()
  2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
  3. fd = ThisWorkbook.Path & "\"  '¸ê®Æ¨Ó·½¥Ø¿ý
  4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '¸ê®Æ¨Ó·½ÀÉ®×(§t°ÆÀɦW)
  5. With Workbooks.Open(fd & fs)
  6.   Set Sh = .Sheets("¦¬¥ó°O¿ý")
  7.       With ThisWorkbook.Sheets("State")
  8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
  9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
  10.             If Not Rng Is Nothing Then
  11.                For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
  12.                   If C = A And InStr(UCase(C.Offset(, 4)), "OBL") > 0 Then
  13.                      ReDim Preserve Ar(s)
  14.                      Ar(s) = C.Offset(, 4)
  15.                      s = s + 1
  16.                   End If
  17.                 Next
  18.             If s > 0 Then A.Offset(, 9) = Join(Ar, "¡B"): Erase Ar: s = 0 Else A.Offset(, 9) = ""
  19.             End If
  20.          Next
  21.       End With
  22.     .Close
  23. End With
  24. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 18# Hsieh

¥i¥H¤F¡A·PÁ¤j¤j

fd = ThisWorkbook.Path & "\"  '¸ê®Æ¨Ó·½¥Ø¿ý
fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '¸ê®Æ¨Ó·½ÀÉ®×(§t°ÆÀɦW)
¥t¥~½Ð°Ý¤W­±¨â¥y
¦pªG§Ú¼g³o¥y´À¥N¤W­±¨â¥yfs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
©ÎªÌ
fd = W:\PIHK\
fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '¸ê®Æ¨Ó·½ÀÉ®×(§t°ÆÀɦW)
³o¼Ë¹ï¶Ü¡H

Join(Ar, "¡B"): Erase ³o¥y¬O¤°»ò·N«ä¡H

¥t¥~½Ð°Ý¦pªG§Ú¥»¨Ó¦bstateªíªºJÄæ¤w¸g¦³¸ê®Æ¡A·|¦]À³¹F¨ì±ø¥ó¦Ó¨ú´À¸ê®Æ¡A¦ý¦pªG­n¸ÓÀx¦s®æ¬OªÅ®æ¤~¨ú´À

If s > 0 and trim(a.Offset(,9) )=¡§¡¨Then a.Offset(, 9) = Join(Ar, "¡B"): Erase Ar: s = 0 Else a.Offset(, 9) = "" ³o¼Ë¼g¹ï¶Ü¡H

TOP

¦^´_ 17# GBKEE


With Sheet1                        (³o¥y¬O§_§ïWith State sheet?)
With Sheet2                 (³o¥y¬O§_§ïWith W:\Payment Daily Report\DOCS RECEIVED N RELEASED RECORD.xlsx ¡H¡^¦ý¬O¦n¹³¤£¹ï¡H¡H

TOP

        ÀR«ä¦Û¦b : ¤f»¡¤@¥y¦n¸Ü¡A¦p¤f¥X½¬ªá¡F¤f»¡¤@¥yÃa¸Ü¦p¤f¦R¬r³D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD