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

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

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

½Ð±Ð¡G
Á`ªí¤º¬°²Î­p¦U¯Zªº¥Í²£¶q¡A
¼W´î¶q¤u§@ªí¡A¬°¨C­Ó¤ëªº¥Í²£¶q¼W´î­È¡C
¥Ø«e¬O¥HEXCEL¨ç¼Æ³B²z¡C
¦]¸ê®Æ¶qÃe¤j¡A½Ð±Ð¤@¤U¤j¤j¡A¦p¦ó¹B¥ÎVBA¡A¦b¥t¤@­Ó¤u§@ªí²£¥Í¼W´î¶qªí¡A¨Ã²£¥Í¨C­Ó®æ¤ºªºÃC¦â®æ¦¡³]©w¡C

¤u1¯Z¨ì¤u9¯Z¡G¼W´î¶q¦pªG¸û¤W­Ó¤ë"¼W¥["ÃC¦â¬°¬õ¦â¡A
                            ¼W´î¶q¦pªG¸û¤W­Ó¤ë"´î¤Ö"ÃC¦â¬°ºñ¦â¡C
¤u10¯Z¨ì¤u15¯Z¡G¼W´î¶q¦pªG¸û¤W­Ó¤ë"¼W¥["ÃC¦â¬°ÂŦâ¡A
                               ¼W´î¶q¦pªG¸û¤W­Ó¤ë"´î¤Ö"ÃC¦â¬°¾ï¦â¡C






°Ý°ÝÃD-102.10.2.rar (3.62 KB)

¥»©«³Ì«á¥Ñ 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

¦^´_ 1# ji12345678
  1. Private Sub cbCal_Click()
  2.   Dim iSCol%, iTCol%, iNum%
  3.   Dim lSRow&, lTRow&
  4.   Dim sStr$
  5.   Dim shSou As Sheet1, shTar As Sheet3

  6.   Set shSou = Sheets("Á`ªí")
  7.   Set shTar = Sheets("ÅÜ°Ê")
  8.   
  9.   With shTar.Cells
  10.     .ClearContents
  11.     .Interior.ColorIndex = -4142
  12.   End With
  13.   
  14.   With shSou
  15.     iSCol = 2 ' ¤é´Á»P¼W´î¶q
  16.     Do While .Cells(1, iSCol) <> ""
  17.       shTar.Cells(1, iSCol) = .Cells(1, iSCol)
  18.       shTar.Cells(2, iSCol) = "¼W´î¶q"
  19.       iSCol = iSCol + 1
  20.     Loop
  21.     sStr = Cells(1, iSCol - 1).Address
  22.     sStr = Mid(sStr, 2, InStr(2, sStr, "$") - 2)
  23.     shTar.Columns("B:" & sStr).ColumnWidth = 8.38
  24.    
  25.     lSRow = 3 ' ¤u¯Z¦W
  26.     Do While .Cells(lSRow, 1) <> ""
  27.       shTar.Cells(lSRow, 1) = .Cells(lSRow, 1)
  28.       lSRow = lSRow + 1
  29.     Loop
  30.    
  31.     iSCol = 3
  32.     Do While .Cells(1, iSCol) <> ""
  33.       lSRow = 3
  34.       Do While .Cells(lSRow, 1) <> ""
  35.         sStr = .Cells(lSRow, 1)
  36.         
  37.         If Left(sStr, 1) <> "Á`" Then iNum = CInt(Mid(sStr, 2, Len(sStr) - 2)) Else iNum = 1
  38.         
  39.         With .Cells(lSRow, iSCol)
  40.          shTar.Cells(lSRow, iSCol) = .Value - .Offset(, -1)
  41.         End With
  42.         
  43.         With shTar.Cells(lSRow, iSCol)
  44.           Select Case .Value
  45.             Case Is > 0
  46.               If iNum > 9 Then .Interior.ColorIndex = 41 Else .Interior.ColorIndex = 38
  47.             Case 0
  48.               .Interior.ColorIndex = -4142
  49.             Case Is < 0
  50.               If iNum > 9 Then .Interior.ColorIndex = 46 Else .Interior.ColorIndex = 35
  51.           End Select ' ÂÅ 41 ¾ï 46 ºñ 35 ¯» 38
  52.         End With
  53.         lSRow = lSRow + 1
  54.       Loop
  55.       iSCol = iSCol + 1
  56.     Loop
  57.   End With
  58. End Sub
½Æ»s¥N½X
°Ý°ÝÃD-102.10.2-a.zip (14.43 KB)

TOP

³Â»¶½×ôίu¬O°ª¤â¦p¶³¡I
·PÁ¦U¦ì¤j¤j±Ð¾É¡I¥t¥~½Ð±Ð¤@¤U¡C¡C¡C¡C¡C¡C¡C
¦³§_¤°»ò«ü¥O©Î¤èªk¬O ¤@­Ó°Ï«°¤ºªº¥þ³¡Àx¦s®æ¡A¤j©ó¹s´N³]¬õ¦â ¡A¤p©ó¹s´N³]ºñ¦â¡C
¨Ó¨ú¥N¤@­Ó¤@­Ó¶]Àx¦s®æ¡H
¸U¤À·P®¦¡AÁÂÁÂ~~~~¡I

TOP

¯u¤£¦n·N«ä¡A
¬O§_¯à¨Ï¥ÎVBA¥ý³]¦n ¤@®æ  "³]©w®æ¦¡¤Æªº±ø¥ó(¢Ò)"
¦A¥u±N¥¦ªº®æ¦¡½Æ»s¨ì¨ä¥Lªº¤j¶qÀx¦s®æ¡H

¸U¤À·PÁ«ü±Ð¡AÁÂÁÂ~~~~¡I

TOP

        ÀR«ä¦Û¦b : ¥Í®ð¡A´N¬O®³§O¤Hªº¹L¿ù¨ÓÃg»@¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD