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

¦A°Ý¸ê®Æ±Æ§Ç

¦A°Ý¸ê®Æ±Æ§Ç

½Ð°Ý¦U¦ì¹F¤H
§Ú¦³¤T­Ó¤u§@ªí¤À§O¬°
¤u§@ªí1
A
5
8
¤u§@ªí2
A
1
2
7
¤u§@ªí3
3
6
²{¦b·Q³]­p¤@­Óµ{¦¡¦b§R±¼¤u§@ªí2ªº(A2)ªº2«á
Åܦ¨
¤u§@ªí1
A
4
7
¤u§@ªí2
A
1

6
¤u§@ªí3
2
5
¸Ó«ç»ò¼g¤ñ¸û¦n

ÁÂÁÂkimbal¤Îc_c_lai¨â¦ì,¤£¹L§Ú¸ê½è¾q¶w,¤Ï¦Ó¬Ofunction¬Ý¤£À´,
·Q¶i¤@¨B½Ð±Ð,ZªºÅܼƬO°µ¬Æ»ò¥Î,
         For Each objKey In objDict
        strDict(X, dictKey) = CStr(objKey)
        strDict(X, dictItem) = CStr(objDict(objKey))
        X = X + 1
³o¤@¬q§ó¬O§¹¥þ¤£À´??
¥t¥~¦pªG¤u§@ªíÅܦ¨
§@ªí1
A
1-2
2-1
¤u§@ªí2
A
1-3
2-1
3-1
¤u§@ªí3
1-4
2-2
²{¦b·Q³]­p¤@­Óµ{¦¡¦b§R±¼¤u§@ªí2ªº(A2)ªº2«á
Åܦ¨
¤u§@ªí1
A
1-2
2-1
¤u§@ªí2
A
1-3

3-1
¤u§@ªí3
1-4
2-1
µ{¦¡¤S­n¦p¦ó§ï¼g

TOP

¦^´_ 2# kimbal
½Ð±Ð±z¡G
¬°¤°»ò§âµ{¦¡½X©ñ¶iTHISWORKBOOK®É¡A¦b¦U¤u§@ªí³æ¤ºÄ²µo Change ®É¡A
recalc »Ý«ü©w ThisWorkbook. ¦p¹Ï¥Ü
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not (Intersect(Target, Columns(1)) Is Nothing) Then
  3.         Application.EnableEvents = False
  4.         Call ThisWorkbook.recalc
  5.         Application.EnableEvents = True
  6.     End If
  7. End Sub
½Æ»s¥N½X
¦Ó¦pªG©ñ¸m©ó Module1 ¤º«h¤£¶·«ü©w
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not (Intersect(Target, Columns(1)) Is Nothing) Then
  3.         Application.EnableEvents = False
  4.         Call recalc
  5.         Application.EnableEvents = True
  6.     End If
  7. End Sub
½Æ»s¥N½X
ÁÂÁ«ü±Ð¡I

TOP

§â³o¨â¬q©ñ¶iTHISWORKBOOK ©ÎMODULE
  1. Public Sub recalc()
  2.     Set dict = CreateObject("Scripting.Dictionary")
  3.    
  4.     Dim shtCurr As Worksheet
  5.     Dim rng As Range
  6.     For Each shtCurr In ThisWorkbook.Worksheets
  7.         Set rng = Intersect(shtCurr.Columns(1), shtCurr.UsedRange)
  8.         For Each c In rng.Cells
  9.             If c <> "" Then
  10.                 dict.Add Item:=c.Value, Key:=shtCurr.Name & "!" & c.Address
  11.             End If
  12.         Next
  13.     Next
  14.    
  15.     Call SortDictionary(dict, 2)
  16.    
  17.     cnt = 1
  18.     For Each kk In dict.keys
  19.         Worksheets(Split(kk, "!")(0)).Range(Split(kk, "!")(1)).Value = cnt
  20.         cnt = cnt + 1
  21.     Next
  22. End Sub

  23. Public Function SortDictionary(ByRef objDict, ByRef intSort)
  24.     Const dictKey = 1
  25.     Const dictItem = 2

  26.   ' declare our variables
  27.   Dim strDict()
  28.   Dim objKey
  29.   Dim strKey, strItem
  30.   Dim X, Y, Z

  31.   ' get the dictionary count
  32.   Z = objDict.Count

  33.   ' we need more than one item to warrant sorting
  34.   If Z > 1 Then
  35.     ' create an array to store dictionary information
  36.     ReDim strDict(Z, 2)
  37.     X = 0
  38.     ' populate the string array
  39.     For Each objKey In objDict
  40.         strDict(X, dictKey) = CStr(objKey)
  41.         strDict(X, dictItem) = CStr(objDict(objKey))
  42.         X = X + 1
  43.     Next

  44.     ' perform a a shell sort of the string array
  45.     For X = 0 To (Z - 2)
  46.       For Y = X To (Z - 1)
  47.         'If StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare) > 0 Then
  48.         If Val(strDict(X, intSort)) > Val(strDict(Y, intSort)) Then
  49.             strKey = strDict(X, dictKey)
  50.             strItem = strDict(X, dictItem)
  51.             strDict(X, dictKey) = strDict(Y, dictKey)
  52.             strDict(X, dictItem) = strDict(Y, dictItem)
  53.             strDict(Y, dictKey) = strKey
  54.             strDict(Y, dictItem) = strItem
  55.         End If
  56.       Next
  57.     Next

  58.     ' erase the contents of the dictionary object
  59.     objDict.RemoveAll

  60.     ' repopulate the dictionary with the sorted information
  61.     For X = 0 To (Z - 1)
  62.       objDict.Add strDict(X, dictKey), strDict(X, dictItem)
  63.     Next

  64.   End If

  65. End Function
½Æ»s¥N½X
µM«á§â¥H¤U³o¬q©ñ¶i¨C­Ó¤u§@ªí
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not (Intersect(Target, Columns(1)) Is Nothing) Then
  3.         Application.EnableEvents = False
  4.         Call recalc
  5.         Application.EnableEvents = True
  6.     End If
  7. End Sub
½Æ»s¥N½X
¯d·N¹ï¤ñªº¤èªk¬O¥Î¼Æ¦r
Val(strDict(X, intSort)) > Val(strDict(Y, intSort))

°Ñ¦Ò
http://support.microsoft.com/kb/246067
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

        ÀR«ä¦Û¦b : ¶¢¤HµL¼Ö½ì¡A¦£¤HµL¬O«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD