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

[µo°Ý] excel¸ê®Æ­pºâ-¨Ã¾É¤J¥t¤@­Ósheet

[µo°Ý] excel¸ê®Æ­pºâ-¨Ã¾É¤J¥t¤@­Ósheet

½Ð°Ý¦³¤H¥i¥HÀ°À°¦£¶Ü?
¦p¦ó±Nªþ¥ó¤¤ªº¸ê®Æsheet1¡A¸g¹L¾ã¨Ã­pºâ¡AµM«á¾É¤Jsheet2

·PÁÂ


1128-3498.rar (43.65 KB)

¦^´_ 1# wwxscl
  1. Private Sub cbCal_Click()
  2.   Dim iI%, iJ%
  3.   Dim lRow&(0 To 1)
  4.   Dim sStr$
  5.   Dim vB, vS, vM ' ¶R¶i±i¼Æ,½æ¥X±i¼Æ,®t»ù(+¶R-½æ)
  6.   Dim vK, vBI, vSI, vMI
  7.   
  8.   Set vB = CreateObject("Scripting.Dictionary")
  9.   Set vS = CreateObject("Scripting.Dictionary")
  10.   Set vM = CreateObject("Scripting.Dictionary")
  11.   
  12.   lRow(0) = 4
  13.   With Sheets("Sheet1")
  14.     Do While .Cells(lRow(0), 2) <> ""
  15.       For iI = 0 To 1
  16.         If .Cells(lRow(0), 2 + iI * 6) <> "" Then
  17.           With .Cells(lRow(0), 2 + iI * 6)
  18.             sStr = Mid(.Text, 7)
  19.             vM(sStr) = vM(sStr) + (.Offset(, 2) * .Offset(, 1)) - (.Offset(, 3) * .Offset(, 1))
  20.             vB(sStr) = vB(sStr) + (.Offset(, 2) / 1000)
  21.             vS(sStr) = vS(sStr) + (.Offset(, 3) / 1000)
  22.           End With
  23.         End If
  24.       Next iI
  25.       lRow(0) = lRow(0) + 1
  26.     Loop
  27.   End With
  28.   
  29.   vK = vB.keys
  30.   vBI = vB.items
  31.   vSI = vS.items
  32.   vMI = vM.items
  33.   lRow(0) = 3
  34.   lRow(1) = 3
  35.    With Sheets("Sheet2")
  36.     .Select
  37.     For iI = 0 To vM.Count - 1
  38.       iJ = -(vMI(iI) < 0)
  39.       .Cells(lRow(iJ), 1 + (iJ * 6)) = vK(iI)
  40.       .Cells(lRow(iJ), 2 + (iJ * 6)) = vBI(iI)
  41.       .Cells(lRow(iJ), 3 + (iJ * 6)) = vSI(iI)
  42.       .Cells(lRow(iJ), 4 + (iJ * 6)) = Abs(vBI(iI) - vSI(iI))
  43.       If vBI(iI) - vSI(iI) = 0 Then
  44.         .Cells(lRow(iJ), 5 + (iJ * 6)) = 0
  45.       Else
  46.         .Cells(lRow(iJ), 5 + (iJ * 6)) = Abs(vMI(iI) / (vBI(iI) - vSI(iI))) / 1000
  47.       End If
  48.       lRow(iJ) = lRow(iJ) + 1
  49.     Next
  50.   End With
  51. End Sub
½Æ»s¥N½X
1128-3498-a.zip (61.53 KB)

TOP

«z
¶W±jªº°Õ
¤j·PÁÂ
¦ý§Ú¤£¯à¤U¸üªþ¥ó¡A¥i¥Hmailµ¹§Ú¶Ü =¤f=
[email protected]

TOP

        ÀR«ä¦Û¦b : ¬°¦Û¤v§äÂǤfªº¤H¥Ã»·¤£·|¶i¨B¡C
ªð¦^¦Cªí ¤W¤@¥DÃD