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

[µo°Ý] VBA_½Ð²¤Æµ{¦¡½X¡CÁÂÁÂ!

¦^´_ 29# Airman
¦³¤@­Ó(§t)¥H¤Wªº¥æ¶°­È(07,39)®É
¥æ¶°­È À³¦³³W«ß©Ê,¥iÅýµ{¦¡¥h³]©w
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim b As Range, Rng As Range, E, C As Variant, Ar(), x_No, x As Variant
  4.     Dim xRng As Range, Color_Ar(), i As Integer
  5.     x_No = Array(7, 39)
  6.     Color_Ar = Array(4, 45, 8)
  7.     With Sheets(2)
  8.         .Activate   '±N¥Ø«eªº¤u§@ªí¦¨¬°¨Ï¥Î¤¤ªº¤u§@ªí¡Cµ¥¦P©ó«ö¤@¤U¤u§@ªí¯Á¤Þ¼ÐÅÒ¡C
  9.         Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7]
  10.         Set Rng = .Range("J7:P" & .[R6] + 5)                '©Ò½Æ»s¸ê®Æªº½d³ò
  11.         Set xRng = .Range("T7:T" & .[R6] + 5)               'TÄ檺½d³ò
  12.         If Application.Count(xRng) = 0 Then Exit Sub        'TÄæ¨S¦³´Á¼Æ®ÉÂ÷¶}µ{¦¡
  13.         For Each b In xRng.SpecialCells(xlCellTypeConstants) 'TÄæ [¦³´Á¼ÆªºÀx¦s®æ]½d³ò
  14.             Ar = Array(.Range("R" & b.Row).Value, .Range("R" & b.Row) - .[T3], .Range("R" & b.Row) - .[T3] * 2) '´Á§Oªº°}¦C
  15.             '°}¦C:¨ä¦bRÄ檺¹ïÀ³´Á¼Æ
  16.             For i = 0 To UBound(Ar)                 '°}¦C¤¸¯À¤U­­­È±q0¶}¨Ï
  17.                 For Each x In x_No                  '¤ñ¹ï¼Æ¦rªº°j°é
  18.                     C = Application.Match(x, Rng.Rows(Ar(i)), 0) '§ä¨ì¶Ç¦^¼Æ¦r
  19.                     If IsNumeric(C) Then Rng.Rows(Ar(i)).Cells(C).Interior.ColorIndex = Color_Ar(i)
  20.                 Next
  21.             Next
  22.         Next
  23.         .[a1].Select  '·Æ¹«°±¯d¦bSheets(2)ªº A1
  24.     End With
  25. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ Airman ©ó 2015-11-24 10:01 ½s¿è

¦^´_ 31# GBKEE
GBKEE¶Wª©¤j:±z¦n!
¤£¦n·N«ä¡A±zÁÙ±Nµ{¦¡½X¥þ¥[µù¸Ñ~¨¯­W±z¤F!·P®¦

«D±`±µªñ¤F!¥u³Ñ¤U¥æ¶°­Èªº©w¸q¦³»~®t~
¥ý°²³]ARR=.Range("R" & b.Row),.Range("R" & b.Row)-T$3, .Range("R" & b.Row)-T$3*2¤T­Ó´Á¼Æªº½d³ò¡A¥H§Q»¡©ú¡C

¥Ø«e¶Qµ{¦¡¬O¨Ì¾Úx_No = Array(m, n)¬O¹w³]¤§©T©wªº·j´M­È~
§Y·ím¶ñ¤J07¡An¶ñ¤J39,«h±N¦bARR¦³Åã¥Ü07©Î39ªºÀx¦s®æ¦U¼Ð¥Ü©³¦â(¤£»Ý­n3­Ó´Á¼Æ¦P®É³£¦³)¡F
¤S¦p·ím¶ñ¤J01¡An¶ñ¤J49,«h±N¦bARR¦³Åã¥Ü01©Î49ªºÀx¦s®æ¦U¼Ð¥Ü©³¦â(¤£»Ý­n3­Ó´Á¼Æ¦P®É³£¦³)¡F....¨ä¾l¥H¦¹Ãþ±À¡C

¥»Åé»Ý¨Dªº¥æ¶°­È¬O¯B°Êªº(§Y«D¹w³]ªº)~
§Y¬O¨Ì¾ÚARRªº3­Ó´Á¼Æ¬O§_¦P®É³£¦³¬Û¦P¼Æ¦r¨Ó¨M©w¡J¦pªG3­Ó´Á¼Æ³£¦³¬Û¦Pªº¼Æ¦r®É¡A«h¸Ó¬Û¦P¼Æ¦r§Y¬°¥æ¶°­È~
EX1_§Y·íARRªº¥æ¶°­È¬°01(§Y¥²¶·3­Ó´Á¼Æ¦P®É³£¦³01)®É¡A«h3­Ó´Á¼ÆÅã¥Ü01ªºÀx¦s®æ¦U¼Ð¥Ü©³¦â¡F
EX2_§Y·íARRªº¥æ¶°­È¬°07,39(§Y¥²¶·3­Ó´Á¼Æ¦P®É³£¦³07,39)®É¡A«h3­Ó´Á¼ÆÅã¥Ü07,39ªºÀx¦s®æ¦U¼Ð¥Ü©³¦â¡F
EX3_·íARRªº¥æ¶°­È¬°08,20,40(§Y¥²¶·3­Ó´Á¼Æ¦P®É³£¦³08,20,40)®É¡A«h3­Ó´Á¼ÆÅã¥Ü08,20,40ªºÀx¦s®æ¦U¼Ð¥Ü©³¦â¡F
EX4_·íARR³£¨S¦³¥æ¶°­È(§Y3­Ó´Á¼Æ¨S¦³¦P®É³£¦³¬Û¦Pªº¼Æ¦r)®É¡A«h3­Ó´Á¼ÆªºÀx¦s®æ³£¬°µL©³¦â¡C..... ¨ä¾l¥H¦¹Ãþ±À¡C

¥H¤W ÂԨѰѦÒ!ÁÂÁ±z!

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-11-24 12:18 ½s¿è

¦^´_ 30# Airman


x_No = Array(7, 39)¡@¶WªOÁÙ¬O¥H¬°7,39¬O¡e¤wª¾¡f±ø¥ó¡A©Ò¥H§Ú¤~»¡­n¥[µù»¡©ú¡I¡I^ ^

¸ÕµÛ¥H¦p¤U¥h¸Ñ»¡¡G
¦³¢Ï¡D¢Ð¡D¢Ñ¤T°Ï¡A¨C°Ï¢¶®æ¡A¨C°Ï¦U¦³¢¶­Ó¢°¡ã¢³¢¸¤£­«ÂмƦr¡A
§ä¥X³o¤T°Ï¡e¦@¦³¡fªº¼Æ¦r¨Ã¤À§O¶ñ¤J©³¦â ¡]¦@¦³¼Æ¦r¶·¥ý¦æÀË´ú¡AµL¹w³]­È¡^¡A
¨Ò¦p¤U¤è½d¨Ò¡AÀË´ú«á¨ú±o¦@¦P¼Æ¦r¬°¡G¢¯¢¶¡D¢²¢¸¡D¢°¢²
¢Ï°Ï¡G
07121728394313

¢Ð°Ï¡G
01071339424549

¢Ñ°Ï¡G
07091320213949

¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
#11 ¬O¥H¡e¤@­Ó¼Æ¦r¡f¥h¤ñ«Ê¤T°Ï¡A©Ò¥H¸û²³æ¡A
¦¹»Ý¨D¬O¢¶­Ó¼Æ¦r³v¤@¤ñ¹ï¤T°Ï¡A1 To 3 ¤Î 1 To 7 °j°é¬Ù¤£¤F¡A¦]¬°Äæ¦ì¤£¤@¼Ë¡A
­Y­n¨D¼Æ¦r¤ÎÄæ¦ì¬Û¦P¡A§Y¦p#27¡A¥Î 1 To 7 °j°é§Y¥i¡A¤Ï¦Ó¸û¬Ù¨Æ¡F
¥H¦¹»Ý¨Dªº°j°é¤£ºâ¤j¡AÀ³ÁÙ¤£¤Ó¼vÅT¹B¦æ³t«×¡A
­Y´î¤Ö°j°é¥H¨ç¼Æ¥N´À¡A¤]¨Ã¤£¨£±o¸û¦n¡A²¦³º¨ç¼Æªº®Ä²v¦³®É·|­°§C³t«×¡ã¡ã

TOP

¦^´_ 33# ­ã´£³¡ªL
­ã¤j:
¨þ~¨þ~ÁÙ¬O±zªº¸Ñ»¡¬J²¥B²M~¤p§Ì©Ó±Ð¤F~§Æ±æ¤p§Ì¤U¦¸ªº»¡©ú¯à§óºë·Ç

­ì¬O·Qµ{¦¡½X¦P¤@¦¡Åé¡A¬JµM±z»¡¨S¦³¯S§O¯q³B~¤p§Ì´N¤£¦A°õµÛ¤F¡C

ÁÂÁ±zªº­@¤ß¦^ÂлP»¡©ú~·P®¦

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2015-11-24 14:45 ½s¿è

¦^´_ 34# Airman

°Ñ¦Ò­ã´£³¡ªL ª©¥D»¡©ú
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Dim Sh As Worksheet '³o¼Ò²Õªº¨p¥ÎÅܼÆ
  3. Private Sub CommandButton1_Click()
  4.     Dim b As Range, Rng As Range
  5.     Dim xRng(1 To 2) As Range
  6.     With Sheets("Sheet1") '­n§e²{ªº¤u§@ªí
  7.         Sheets("DATA").Range("J7", "P" & .[R6] + 5).Copy .[J7]
  8.         Set Rng = .Range("J7:P" & .[R6] + 5)                   '©Ò½Æ»s¸ê®Æªº½d³ò
  9.         Rng.Interior.ColorIndex = xlNone
  10.         Set xRng(1) = .Range("T7:T" & .[R6] + 5)               'TÄ檺½d³ò
  11.         If Application.Count(xRng(1)) = 0 Then Exit Sub        'TÄæ¨S¦³´Á¼Æ®ÉÂ÷¶}µ{¦¡
  12.         
  13.         Set Sh = Sheets.Add(Sheets(1))                         '¼W¥[¤@¤u§@ªí
  14.         Application.ScreenUpdating = False                     '¦pªG¿Ã¹õ§ó·s¥\¯à¬O¶}±Òªº«h¬° True
  15.         For Each b In xRng(1).SpecialCells(xlCellTypeConstants) 'TÄæ [¦³´Á¼ÆªºÀx¦s®æ]½d³ò
  16.             Ex_ChiCK Union(Rng.Rows(.Range("R" & b.Row)), Rng.Rows(.Range("R" & b.Row) - .[T3]), Rng.Rows(.Range("R" & b.Row) - .[T3] * 2))  '´Á§Oªº°}¦C
  17.             'Ex_ChiCK Union(Rng.Rows(.Range("R" & b.Row) - .[T3] * 2), Rng.Rows(.Range("R" & b.Row) - .[T3]), Rng.Rows(.Range("R" & b.Row)))  '­ËÂà´Á§O
  18.         Next
  19.         .Activate   '±N¥Ø«eªº¤u§@ªí¦¨¬°¨Ï¥Î¤¤ªº¤u§@ªí¡Cµ¥¦P©ó«ö¤@¤U¤u§@ªí¯Á¤Þ¼ÐÅÒ¡C
  20.         .[a1].Select  '·Æ¹«°±¯d¦bSheets(2)ªº A1
  21.     End With
  22.     Application.DisplayAlerts = False  '¦pªG¥¨¶°¦b°õ¦æ®É Microsoft Excel Åã¥Ü¯S©wªºÄµ§i©M°T®§«h¬° True
  23.     Sh.Delete                          '§R°£:¤u§@ªí
  24.     Application.DisplayAlerts = True
  25.     Application.ScreenUpdating = True
  26. End Sub
  27. Private Sub Ex_ChiCK(Rng As Range)  '°Æµ{¦¡ ¶·¶Ç°e°Ñ¼Æ
  28.     Dim Ar(), i As Variant, E As Variant, X As Variant, M As Integer
  29.     Ar = Array(4, 45, 8)
  30.     Rng.Copy Sh.[a1]             '½Æ»s¤T´Á¸ê®Æ
  31.     For i = 1 To 49
  32.         X = Application.CountIf(Sh.UsedRange, i)  'x = 3 :¦P¤@¸¹½X¤T´Á³£¥X²{
  33.         If X = 3 Then E = E & IIf(E <> "", ",", "") & i  '¬ö¿ý¸¹½X
  34.     Next
  35.     X = Split(E, ",")        '¥X²{3¦¸ªº¸¹½X,¸m¤J°}¦C
  36.     For Each E In X
  37.         For i = 1 To Rng.Areas.Count
  38.             '¶Ç¦^ Areas ¶°¦X¡A¦¹¶°¦X¥Nªí¦h­«½d³ò¤¤ªº©Ò¦³½d³ò
  39.             M = Application.Match(Val(E), Rng.Areas(i).Cells, 0)
  40.             Rng.Areas(i).Cells(M).Interior.ColorIndex = Ar(i - 1) '¨Ì½d³ò¶Ç¦^ªºÃC¦â
  41.         Next
  42.     Next
  43. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ Airman ©ó 2015-11-24 14:24 ½s¿è

¦^´_ 35# GBKEE
GBKEE¶Wª©¤j:±z¦n!
¤£¦n·N«ä~¥u³Ñ¼Ð¥Ü©³¦âªº°ÝÃD¤F~
°²³]:A°Ï=.Range("R" & b.Row)¡FB°Ï=.Range("R" & b.Row)-T$3¡FC°Ï=.Range("R" & b.Row)-T$3*2¡F
«h3°Ïªº¦@¦³¼Æ¦r¡A¨Ì¤À°Ï¤À§O¼Ð¥Ü4¸¹,45¸¹,8¸¹©³¦â~§YA°Ï¼Ð¥Ü4¸¹©³¦â¡FB°Ï¼Ð¥Ü45¸¹©³¦â¡FC°Ï¼Ð¥Ü8¸¹©³¦â ~
EX_1:
C°Ï(72)¡G         07        10        13        20        21        39        18

¢Ð°Ï(81)¡G        01        07        13        39        42        45        12

A°Ï(90)¡G        07        12        17        28        40        41        49

EX_2:
C°Ï(72)¡G         07        09        11        20        21        39        12

¢Ð°Ï(81)¡G        01        07        13        39        42        45        10

A°Ï(90)¡G        07        12        17        28        40        13        39

EX_3:
C°Ï(72)¡G         07        09        13        20        21        39        12

¢Ð°Ï(81)¡G        01        07        13        39        42        45        12

A°Ï(90)¡G        07        10        17        28        40        13        39


EX_4:
C°Ï(72)¡G         07        09        13        20        21        39        12

¢Ð°Ï(81)¡G        01        07        13        39        42        45        12

  A°Ï(90)¡G        07        12        17        28        40        13        39

.....¨ä¾l¥H¦¹Ãþ±À

¥H¤W ÂԨѰѦÒ!ÁÂÁ±z!

TOP

¤£¬O²¤Æ¡A¥t¤@ºØ¼gªk¡A¤ñ­ì¨Ï¥Î¢²¼h°j°é§ó¤£©ö²z¸Ñ¡A°Ñ¦Ò½}¡G

RW = Array(b(1, -1), b(1, -1) - .[T3], b(1, -1) - .[T3] * 2)
For y = 1 To 3: Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Cells: Next y
Dim M(1 To 3)
For k = 1 To 7
¡@¡@M(1) = k
¡@¡@For y = 2 To 3
¡@¡@¡@¡@M(y) = Application.Match(R(1)(k), R(y), 0)
¡@¡@¡@¡@If IsError(M(y)) Then M(1) = 0: Exit For
¡@¡@¡@¡@'If M(y) <> M(1) Then M(1) = 0: Exit For¡@'­Y­n¨D¡e¦PÄæ¡f¡A¥[¤J³o¦æ¡@
¡@¡@Next y
¡@¡@If M(1) > 0 Then
¡@¡@¡@For y = 1 To 3: R(y)(M(y)).Interior.ColorIndex = Array(4, 45, 8)(y - 1): Next
¡@¡@End If
Next k

TOP

¦^´_ 37# ­ã´£³¡ªL
­ã¤j:
·PÁ±z¶O¯«¦A½ç¥t¸Ñ

PS:¥»·Q¥u¥Hµu®ø®§¦V±z­PÁ§Y¥i¡AÁקKµê¨úÂI¼Æ¡A¦ýµL©`¤p§ÌÁÙ¬O¤£²ßºD~Á`ı±o°Ý»Pµª¤§¶¡¤Ö­Ó¥yÂI

TOP

        ÀR«ä¦Û¦b : ¤£©È¨Æ¦h¡A¥u©È¦h¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD