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

[µo°Ý] ¦p¦ó¹ï¯S©wÄæ¶i¦æ¿z¿ï©M´À¥N¸ê®Æ

[µo°Ý] ¦p¦ó¹ï¯S©wÄæ¶i¦æ¿z¿ï©M´À¥N¸ê®Æ

¥»©«³Ì«á¥Ñ luke ©ó 2013-5-25 22:28 ½s¿è

¦U¦ì¥ý¶i

1. sheet1ªíªºA:CÄ欰¸ê®Æ°Ï, ¬ù¦³500¦C(§tªÅ¥Õ¦C), ¨ä¤¤BÄæ¸ê®Æ(§t¦³¶À©³¦âªºÀx¦s®æ), ·í«ö¤U¡y¿z¿ï¡z
    «öÁä´N·|§ì¨úBÄ榳¶À©³ªºÀx¦s®æ¦ÜL:NÄæ(PS: LÄæ=NÄæ, MÄæ¨úCÄæ)

2.§¹¦¨¿z¿ï«á, BÄ榳¶À©³ªºÀx¦s®æ·Q­n§Q¥ÎLÄæ»PNÄæ[NÄæ¬O¥Ñ¤H¤u¿é¤J¸ê®Æ,µø±¡ªp·|°µ­×§ï]¬Û¹ïÀ³Ãö«Y,
   ·í«ö¤U¡y´À¥N¡z«öÁä, ¥u»Ý¹ïBÄæ¶i¦æ¦r¥Àªº´À¥N(¨ä¥LÄæ¦ì¤£»Ý°µ´À¥N),
   §Y¨úNÄæ¬Û¹ïÀ³¦ÜLÄ檺Àx¦s®æ¸ê®Æ, ¥h¹ïBÄæ©Ò¦³¶À©³ªºÀx¦s®æ°µ¤å¦r´À¥N.

3.­YNÄæ¸ê®Æ¤¤, ¦³»PBÄæ«D¶À©³Àx¦s®æªº¸ê®Æ¬Û¦P®É´N°±¤î°õ¦æVBA°Ê§@¨ÃÅã¥Ü¸Ó­«½Æ­È.

·Ð½Ð¥ý¶i ¤j¤j«ü¾É

TEST28.rar (29.58 KB)

¦^´_ 1# luke
  1. Option Explicit
  2. Dim D As Object, DRng As Range
  3. Sub ¿z¿ï()
  4.     ¸ê®Æ¿z¿ï
  5.     With Sheet1.Range("L1")
  6.         .CurrentRegion = ""
  7.         If D.Count = 0 Then Exit Sub
  8.         .Resize(D.Count, 3) = Application.Transpose(Application.Transpose(D.ITEMS))
  9.         .CurrentRegion.Sort .Cells(1)
  10.     End With
  11. End Sub
  12. Sub ´À¥N()
  13.     Dim Rng As Range, R As Range, E As Range, C As Range
  14.     ¸ê®Æ¿z¿ï
  15.     Application.ScreenUpdating = False
  16.     With Sheet1
  17.         .Range("C:C").Value = .Range("C:C").Value  '¥h°£"'"¦r¦ê'L1 ¦h¤@­Ó
  18.         Set Rng = .Range("L1").CurrentRegion
  19.         For Each R In Rng.Columns(2).Cells   'MÄ檺Àx¦s®æ
  20.             If DRng.Find(R.Offset(, 1), lookat:=xlWhole) Is Nothing And Application.CountIf(.[B:B], R.Offset(, 1)) > 0 Then
  21.                 'NÄæ¸ê®Æ¤¤, ¦³»PBÄæ«D¶À©³Àx¦s®æªº¸ê®Æ¬Û¦P®É´N°±¤î°õ¦æVBA->    'NÄ檺¦r¦ê¦b[¿z¿ï¸ê®ÆªºÀx¦s®æ]¤¤¤ñ¹ï¤£¨ì, ¥B[B:B]¤¤¦³¦¹¦r¦ê
  22.                 With .Range("B:B")
  23.                     .Replace R.Offset(, 1), "=XXX", xlWhole
  24.                     With .SpecialCells(xlCellTypeFormulas, xlErrors)
  25.                          .Value = R.Offset(, 1)
  26.                          .Select
  27.                     End With
  28.                 End With
  29.                 MsgBox R.Offset(, 1) & " ¦³­«½Æ­È."
  30.                 End
  31.             End If
  32.             With .Range("C:C")
  33.                 .Replace R.Value, "=XXX", xlWhole
  34.                 With .SpecialCells(xlCellTypeFormulas, xlErrors)
  35.                     .Value = R
  36.                     For Each E In .Areas
  37.                         For Each C In E.Cells
  38.                             If C.Offset(, -1) = R.Offset(, -1) Then C.Offset(, -1) = R.Offset(, 1)
  39.                         Next
  40.                     Next
  41.                 End With
  42.             End With
  43.         Next
  44.     End With
  45.     Application.ScreenUpdating = True
  46. End Sub
  47. Private Sub ¸ê®Æ¿z¿ï()
  48.     Dim R As Range
  49.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  50.     With Sheet1
  51.         For Each R In .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
  52.             If R <> "" And R.Cells(1, 2) <> "" Then
  53.                 D(R & R.Cells(1, 2)) = Array(R, R.Cells(1, 2), R)    '¦s¤J¦r¨åª«¥ó: ¿z¿ïªº¸ê®Æ
  54.                 If DRng Is Nothing Then                              '¿z¿ï¸ê®ÆªºÀx¦s®æ
  55.                     Set DRng = R
  56.                 Else
  57.                     Set DRng = Union(R, DRng)
  58.                 End If
  59.             End If
  60.         Next
  61.    End With
  62. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE


ÁÂÁ¶Wª©¦^ÂÐ

1.·í«ö¤U¡y´À¥N¡z«öÁä¥h¹ïBÄæ¶i¦æ¦r¥Àªº´À¥N®É·|¥X²{1004¿ù»~, ¬O§_¦]°õ¦æ¤lVBA§Y  "¸ê®Æ¿z¿ï" ©Ò³y¦¨?
1004.jpg
2.¦pªGª½±µ§ï¥Î¤U¦C"´À¥N"»yªk¤]³\¸û®e©ö, ¦ý­n¦p¦ó­ÝÅU[NÄæ¸ê®Æ¤¤»PBÄæ«D¶À©³Àx¦s®æªº¸ê®Æ¬Û¦P®É´N°±¤î°õ¦æVBA], À³¦p¦ó­×§ïVBA?

Columns("B:B").Select
Selection.Replace What:=a, Replacement:=a.Offset(, 2), lookat:=xlPart, ReplaceFormat:=False
(a=LÄæ)

¥H¤W

·Ð½Ð«ü¾É.
TEST28A.rar (26.52 KB)

TOP

¦^´_ 3# luke
¦bªþÀɤWªº¦r¦ê L1 ¹ê»Ú¤W¬O 'L1  ->¤å¦r®æ¦¡   
¥Î³o¦æ°£¥h '  ¦b2003ª©¥»¥i°£¥h,¦ý2007ª©¥»¬°¦óµLªk°£¥h©|½Ð¦³2007¸Õ¸Õ¬Ý
  1. .Range("C:C").Value = .Range("C:C").Value  '¥h°£"'"¦r¦ê'L1 ¦h¤@­Ó
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 1# luke
  1. Sub ¿z¿ï()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With sheet1
  4.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
  5.       If a.Interior.ColorIndex = 6 Then d(a.Value) = Array(a, a.Offset(, 1), a)
  6.    Next
  7.    With .Range("L1")
  8.       .CurrentRegion = ""
  9.       .Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
  10.       .Resize(d.Count, 3).Sort .Cells(1, 1), xlAscending, Header:=xlNo
  11.    End With
  12. End With
  13. End Sub
  14. Sub ¨ú¥N()
  15. Set d = CreateObject("Scripting.Dictionary")
  16. Set d1 = CreateObject("Scripting.Dictionary")
  17. With sheet1
  18.    With .Range("L1").CurrentRegion
  19.    For Each a In .Columns(1).Cells
  20.       d(a.Value) = a.Offset(, 2)
  21.       d1(a.Offset(, 2).Value) = a.Value
  22.    Next
  23.    End With
  24.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
  25.      If d1.exists(a.Value) And a.Interior.ColorIndex <> 6 Then MsgBox "¸ê®Æ­«½Æ": Exit Sub
  26.    Next
  27.    For Each a In .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
  28.      If d.exists(a.Value) And a.Interior.ColorIndex = 6 Then a.Value = d(a.Value)
  29.    Next
  30.    MsgBox "¨ú¥N§¹¦¨"
  31. End With
  32. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 5# Hsieh


¦^ÂÐH¶Wª©

ÁÂÁ¨ó§U¶PÀ°¦£­×§ï
¦A¦¸·PÁÂ


¥H¤W

TOP

        ÀR«ä¦Û¦b : ¬O«D·í±Ð¨|¡AÆg¬ü§@ĵ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD