- ©«¤l
- 163
- ¥DÃD
- 1
- ºëµØ
- 0
- ¿n¤À
- 170
- ÂI¦W
- 0
- §@·~¨t²Î
- Window 7
- ³nÅ骩¥»
- Office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2010-9-5
- ³Ì«áµn¿ý
- 2022-7-20
|
¥»©«³Ì«á¥Ñ Kubi ©ó 2016-4-10 21:11 ½s¿è
¥t¥~´£¨Ñ´XºØ¦â±m¼Ð¥Üªk°µ°Ñ¦Ò¡G
¤@¡B¥ý[µ¹È](²£¥Í·s¼Ë¥»)¡A¥H¤è«K°µ´ú¸Õ
¤G¡B§Q¥Î[»²§UÄæ±Æ§Çªk]¨Ó¶ñ¦â
¤T¡B§Q¥Î[»²§UÄæ«D±Æ§Çªk]¨Ó¶ñ¦â
¥|¡B§Q¥Î[°}¦Cªk]¨Ó¶ñ¦â
¤¡B[±Æ§Ç]¬O§@¬°¶ñ¦â«á¡A¤è«K¸ê®ÆÅçÃÒ¤§¥Î
¤»¡B¦p¥Î¦rÂIÀÉ(Dictionary)¨Ó¶ñ¦â¤]¥iºÉ¥\¡A½Ð¦Û¦æ¼¶¼g
©³¤U´N¦¡µ{¦¡½X©å§@¡G
Option Base 1
Sub µ¹È()
Randomize
Cells.Interior.ColorIndex = xlNone
Cells.ClearContents
er = Int(Rnd * 100) + 10
Application.ScreenUpdating = False
For c = 1 To Int(Rnd * 10) + 2
For r = 1 To er
Cells(r, c).Value = Int(Rnd * 1000)
Next r
Next c
Application.ScreenUpdating = True
End Sub
Sub »²§UÄæ±Æ§Çªk()
ci = Array(3, 8, 6)
er = [A1].CurrentRegion.Rows.Count
ec = [A1].CurrentRegion.Columns.Count + 1
Application.ScreenUpdating = False
For i = 1 To er
Cells(i, ec).Value = i
Next i
For c = 1 To ec - 1
Range(Cells(1, c), Cells(er, ec)).Sort key1:=Cells(1, c), order1:=2
x = -1
n = -1
For Each cell In Cells(1, c).Resize(er)
If cell.Value <> n Then
n = cell.Value
x = x + 1
If x = 3 Then Exit For
cell.Interior.ColorIndex = ci(x + 1)
Else
cell.Interior.ColorIndex = ci(x + 1)
End If
Next cell
Range(Cells(1, c), Cells(er, ec)).Sort key1:=Cells(1, ec), order1:=1
Next c
Columns(ec).ClearContents
Application.ScreenUpdating = True
End Sub
Sub »²§UÄæ«D±Æ§Çªk()
ci = Array(3, 8, 6)
er = [A1].CurrentRegion.Rows.Count
ec = [A1].CurrentRegion.Columns.Count
Application.ScreenUpdating = False
For c = 1 To ec
Range(Cells(1, ec + 1), Cells(er, ec + 2)).ClearContents
For r = 1 To er
For i = 1 To 3
If Cells(i, ec + 1).Value = "" Then
Cells(i, ec + 1).Value = Cells(r, c).Value
Cells(i, ec + 2).Value = Trim(r)
Exit For
Else
If Cells(r, c).Value = Cells(i, ec + 1).Value Then
Cells(i, ec + 2).Value = Cells(i, ec + 2).Value & "," & Trim(r)
Exit For
Else
If Cells(r, c).Value > Cells(i, ec + 1).Value Then
Range(Cells(i, ec + 1), Cells(i, ec + 2)).Insert Shift:=xlDown
Cells(i, ec + 1).Value = Cells(r, c).Value
Cells(i, ec + 2).Value = Trim(r)
Exit For
End If
End If
End If
Next i
Next r
For i = 1 To 3
n = Split(Cells(i, ec + 2).Value, ",")
For j = 0 To UBound(n)
Cells(n(j), c).Interior.ColorIndex = ci(i)
Next j
Next i
Next c
Range(Cells(1, ec + 1), Cells(er, ec + 2)).ClearContents
Application.ScreenUpdating = True
End Sub
Sub °}¦Cªk()
Dim arr
Dim brr()
ci = Array(3, 8, 6)
arr = [A1].CurrentRegion
ec = UBound(arr, 2)
er = UBound(arr)
For c = 1 To ec
ReDim brr(3, 2)
For r = 1 To er
n = arr(r, c)
For i = 1 To 3
If n = brr(i, 1) Then
brr(i, 2) = brr(i, 2) & "," & r
Exit For
End If
If brr(i, 1) = "" Then
brr(i, 1) = n
brr(i, 2) = r
Exit For
Else
If n > brr(i, 1) Then
For j = 3 To i + 1 Step -1
brr(j, 1) = brr(j - 1, 1)
brr(j, 2) = brr(j - 1, 2)
Next j
brr(i, 1) = n
brr(i, 2) = r
Exit For
End If
End If
Next i
Next r
For i = 1 To 3
x = Split(brr(i, 2), ",")
For j = 0 To UBound(x)
Cells(x(j), c).Interior.ColorIndex = ci(i)
Next j
Next i
Next c
End Sub
Sub ±Æ§Ç()
ec = [A1].End(2).Column
er = [A65536].End(3).Row
Application.ScreenUpdating = False
For c = 1 To ec
Range(Cells(1, c), Cells(er, c)).Sort key1:=Cells(1, c), order1:=2
Next c
Application.ScreenUpdating = True
End Sub |
|