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

[µo°Ý] ¦p¦ó§Q¥Î®Ö¨ú¤è¶ô°µ¼Æ¶q¥[Á`­pºâ

¦^´_ 20# GBKEE


   ¦^ÂÐG¤j

¸ÓÀɬOª½±µ©I¥s¥¨¶°°õ¦æ
¦pªþÀÉ»¡©ú
TEST13-1.gif

TOP

¦^´_ 19# luke
  1. Sub ex()
  2. Dim Mystr$, A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With sheet1
  5. For Each sp In .Shapes
  6. If sp.Name Like "Check*" Then
  7.   If sp.OLEFormat.Object.Value = 1 Then Mystr = Mystr & "," & sp.OLEFormat.Object.Caption
  8. End If
  9. Next
  10. For Each A In .Range(.[A10], .Cells(.Rows.Count, 1).End(xlUp))
  11. k = Asc(A.Offset(, 5)) - 63
  12.   If InStr(Mystr, A) > 0 Then
  13.     d(k & "," & A.Offset(, 1) & "," & A.Offset(, 2)) = d(k & "," & A.Offset(, 1) & "," & A.Offset(, 2)) + A.Offset(, 3)
  14.   End If
  15. Next
  16. End With

  17. For i = 2 To 4
  18. With Sheets(i)
  19. If Application.CountA(.Columns("A")) > 0 Then
  20. For Each A In .Range(.[A2], .Cells(.Rows.Count, 2).End(xlUp))
  21.    A.Offset(, 3) = A.Offset(, 2) + d(i & "," & A & "," & A.Offset(, 1))
  22.    d.Remove i & "," & A & "," & A.Offset(, 1)
  23. Next
  24. End If
  25. End With
  26. Next
  27. For Each ky In d.keys
  28. ar = Split(ky, ",")
  29. With Sheets(CInt(ar(0)))
  30. Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
  31. A = ar(1): A.Offset(, 1) = ar(2): A.Offset(, 3) = d(ky)
  32. End With
  33. Next
  34. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-4-25 10:24 ½s¿è

¦^´_ 21# luke
§Ú 2# ¦³¼g   ±N©Ò¦³ªº®Ö¨ú¤è¶ô «ü©w¥¨¶° ¬°¦¹µ{§Ç
¨C¤@­Ó ®Ö¨ú¤è¶ô ³£¶·  «ü©w¥¨¶° ¬°¦¹µ{§Ç  µM«á «ö¤U  ®Ö¨ú¤è¶ô ·|°õ¦æ³o µ{§Ç ¸Õ¸Õ¬Ý

TOP

¦^´_ 23# GBKEE


    ¦^ÂÐG¤j

     ±Nsheet1ªí¨C­Ó®Ö¨ú¤è¶ô«ü©w¥¨¶°«á
     °õ¦æ¸Ó¥¨¶°®É¤´·|¥X°ÝÃD¦p¤U»¡©ú:
    TEST13-3.gif

TOP

¦^´_ 22# Hsieh


    ÁÂÁÂH¤j

     sheet1ªí¥¨¶°°õ¦æ«á
     sheet2ªí¦Üsheet4ªí¦h¥X¤FEÄæ(¼Æ¶q­«ÂÐ)
     ¦p¯»¬õ¦â°Ï
TEST13E.rar (32.75 KB)

TOP

¦^´_ 24# luke
xlWord As String   §R±¼ As String   ¦A¸Õ¬Ý¬Ý

TOP

¦^´_ 25# luke
  1. Sub ex()
  2. Dim Mystr$, A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With sheet1
  5. For Each sp In .Shapes
  6. If sp.Name Like "Check*" Then
  7.   If sp.OLEFormat.Object.Value = 1 Then Mystr = Mystr & "," & sp.OLEFormat.Object.Caption
  8. End If
  9. Next
  10. For Each A In .Range(.[A10], .Cells(.Rows.Count, 1).End(xlUp))  ³oÃäCells(.Rows.Count, 2)§ï¦¨Cells(.Rows.Count, 1)
  11. k = Asc(A.Offset(, 5)) - 63
  12.   If InStr(Mystr, A) > 0 Then
  13.     d(k & "," & A.Offset(, 1) & "," & A.Offset(, 2)) = d(k & "," & A.Offset(, 1) & "," & A.Offset(, 2)) + A.Offset(, 3)
  14.   End If
  15. Next
  16. End With

  17. For i = 2 To 4
  18. With Sheets(i)
  19. If Application.CountA(.Columns("A")) > 0 Then
  20. For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
  21.    A.Offset(, 3) = A.Offset(, 2) + d(i & "," & A & "," & A.Offset(, 1))
  22.    d.Remove i & "," & A & "," & A.Offset(, 1)
  23. Next
  24. End If
  25. End With
  26. Next
  27. For Each ky In d.keys
  28. ar = Split(ky, ",")
  29. With Sheets(CInt(ar(0)))
  30. Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
  31. A = ar(1): A.Offset(, 1) = ar(2): A.Offset(, 3) = d(ky)
  32. End With
  33. Next
  34. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 21# luke

³o­Ó¿ù»~¬O¨Ó¦ÛApplication.Caller
¥²¶·¥H¤Ä¿ï®Ö¨ú¤è¶ôÅX°Êµ{¦¡
¤£¯àª½±µ°õ¦æ¥¨¶°
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

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