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

[µo°Ý] ½Ð±Ð¦p¦ó¥ÎVBA¦b¥t¤@¤u§@ªí­pºâ¥Xµ²ªG¡H

¥»©«³Ì«á¥Ñ kimbal ©ó 2013-10-3 23:34 ½s¿è

¦^´_ 1# ji12345678
  1. Sub TEST()

  2.     Dim color As Long
  3.     Application.Calculation = xlCalculationManual
  4.     Application.ScreenUpdating = False
  5.    
  6.     Sheets("Á`ªí").Copy after:=Sheets(1)
  7.     With ActiveSheet.Range("B3")
  8.         Range(.Address, .End(xlToRight).End(xlDown)).ClearFormats
  9.         Range(.Address, .End(xlToRight).Offset(0, -1).End(xlDown)).Select
  10.         Selection.Copy
  11.         .Offset(0, 1).PasteSpecial operation:=xlPasteSpecialOperationSubtract
  12.         
  13.    
  14.         For Each Rng In Range(.Offset(0, 1), .End(xlToRight).End(xlDown))
  15.             color = 0
  16.             If Rng.Row >= 12 And Rng.Row <= 17 Then
  17.                 If Rng.Value > 0 Then
  18.                     color = 15773696
  19.                 ElseIf Rng.Value < 0 Then
  20.                     color = 52479
  21.                 End If
  22.             Else
  23.                 If Rng.Value > 0 Then
  24.                     color = 255
  25.                 ElseIf Rng.Value < 0 Then
  26.                     color = 5296274
  27.                 End If
  28.             End If
  29.             If color > 0 Then
  30.                 With Rng.Interior
  31.                     .Pattern = xlSolid
  32.                     .PatternColorIndex = xlAutomatic
  33.                     .color = color
  34.                 End With
  35.             End If
  36.         Next
  37.         Range(.Address, .End(xlDown)).Clear
  38.     End With
  39.     Application.ScreenUpdating = True
  40.     Application.Calculation = xlCalculationAutomatic

  41. End Sub
½Æ»s¥N½X
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

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

TOP

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