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

[µo°Ý] ¦C¥X¥ý¶i¥ý¥X°T®§

[µo°Ý] ¦C¥X¥ý¶i¥ý¥X°T®§

¦U¦ì¤j¤j


§Ú·Q¦C¥X¦³ÃC¦âªº³¡¤À°T®§

­n¨Ì¬y¤ô¸¹¨Ì§Ç¸ò®w¦s¨ú¸ê®Æ¡A¨Cµ§¸ê®Æ·|¿W¥ß­pºâ¨Ã®ø¯Ó®w¦s¼Æ

½Ð¦U¦ì¤j¤jµ¹§ÚÂI´£¥Ü¡A·PÁÂ

test.zip (10.14 KB)

  1. Sub zz()
  2. Selection.Clear
  3. Dim a, b(), r&, c&, n&, f$, t As Boolean
  4. a = [a1].CurrentRegion
  5. r = UBound(a) - 1
  6. c = (UBound(a, 2) - 3) / 2
  7. ReDim b(1 To r * c, 1 To 3)
  8. t = True
  9. For i = 2 To UBound(a)
  10.     For j = 4 To UBound(a, 2) Step 2
  11.         If IsDate(a(i, j)) Then
  12.             If t Then f = Cells(i, j).NumberFormatLocal: t = false
  13.             n = n + 1
  14.             b(n, 1) = a(i, 2)
  15.             b(n, 2) = a(i, j)
  16.             b(n, 3) = a(i, j + 1)
  17.         End If
  18.     Next
  19. Next
  20. With Cells(2, UBound(a, 2) + 2)
  21.     .Resize(n, 3) = b
  22.     .Offset(0, 1).Resize(n).NumberFormatLocal = f
  23.     .Resize(n, 3).Sort Cells(2, UBound(a, 2) + 2).Offset(0, 1)
  24. End With
  25. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# ikboy

·PÁ³o¦ì¤j¤j¦^´_

¥Ø«e¥X²{¿ù»~ °õ¦æ¶¥¬q¿ù»~'1004':

¦ý¬O¬Ý¤£¤ÓÀ´³o¦ì¤j¤jªºµ{¦¡½X
¤£ª¾¬O¤£¬O§Ú±Ô­zªº¤£¦n¡A§Ú·Q¦Û°Ê¦C¥X¶À¦â°Ï°ì°T®§

¬yµ{¬O
»Ý¨Dªº¶µ¥Ø¡A¨Ì¬y¤ô¸¹¶¶§Ç¥h®w¦s§ä¬Û¦P®Æ¥ó¡A¦pªG¦³¬Û¦Pªº®Æ¥ó«h±N¥L¨ú¥X¨ÃÅã¥Ü¦b¶À¦â°Ï°ìD2:E2¦A¦V¤U´M§ä¬Û¦P®Æ¥ó¸ê®Æ©¹¥k2®æ¦A¦C¥X¡Aª½¨ìº¡¨¬»Ý¨D¼Æ¶q¬°¤î¡A¦pªG¼Æ¶q¤£¨¬«hÅã¥Ü¤£¨¬
¦A¨Ì§Ç¬y¤ô¸¹¶¶§Ç°õ¦æ¡A¦ý¦]¬°«e­±¬y¤ô¸¹ªº®Æ¥ó¤w±N®w¦s¼Æ¶q¨ú¨«¡A©Ò¥H«á­±ªº»Ý¨D«Ü®e©ö¥X²{¼Æ¶q¤£¨¬¡C

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-3-31 00:47 ½s¿è

¦^´_ 3# qaqa3296


¥ý°²©w§Aªº¬y¤ô¸¹±q¤W¨ì¤U³£¬O¥Ñ¤p¨ì¤j

(¦pªG¬y¤ô¸¹¨S¦³³W«ß¥B­n«ö·Ó¬y¤ô¸¹¨Ó¨M©w¥X³f¶¶§Ç¡A·|§ó¿N¸£.........)

¸Õ¸Õ¬Ý§a! ¥»¨Ó·Q¥Î2­Ó¦r¨åªº¡A¤£¹L¦³¤°»òªF¦è¬O1­Ó¦r¨åÁÙ·d¤£©wªº©O?  

³Ì¦h¤]¥u¬O¸ê®Æªø¤@ÂIÂI.....................



Sub Ship()
Set D = CreateObject("Scripting.Dictionary")
Arr = Range([®w¦s!C2], [®w¦s!A5000].End(3))
For R = 1 To UBound(Arr)   '®Æ¥óX¡G>¤é´Á1,®w¦s1>¤é´Á2,®w¦s2>¤é´Á¢²,®w¦s¢²...........
  D(Arr(R, 1)) = D(Arr(R, 1)) & ">" & Arr(R, 2) & "," & Arr(R, 3)
Next
Sheets("µ²ªG").Activate
For R = 2 To [A5000].End(3).Row
  Key$ = Cells(R, 2)
  LData = D(Key)
  If LData = "" Then
    Cells(R, 4) = "¨S¦³¸ê®Æ"
    Cells(R, 5) = "¼Æ¶q¤£¨¬"
    GoTo ¤U¤@¬y¤ô¸¹
  End If
  Data = Split(LData, ">")
  Ci = 4  'DÄæ¶}©l¶ñ
  »Ý¨D = Cells(R, 3)
  For i = 1 To UBound(Data)
    ¤é´Á = Split(Data(i), ",")(0)
    ®w¦s = Split(Data(i), ",")(1)
    If ®w¦s = 0 And i = UBound(Data) Then '³Ì«á¤@µ§¤]¬O®w¦s0
      Cells(R, Ci) = "¨S¦³¸ê®Æ"
      Cells(R, Ci + 1) = "¼Æ¶q¤£¨¬"
      GoTo ¤U¤@¬y¤ô¸¹
    End If
    If ®w¦s = 0 Then GoTo ¤U¤@®w¦s '«D³Ì«á¤@µ§¡A®w¦s0
    If ®w¦s - »Ý¨D >= 0 Then
      Cells(R, Ci) = ¤é´Á
      Cells(R, Ci + 1) = »Ý¨D
      ®w¦s = ®w¦s - »Ý¨D
      Data(i) = ¤é´Á & "," & ®w¦s
      GoTo ¤w¥X³f§¹
    Else  '®w¦s - »Ý¨D <0
      Cells(R, Ci) = ¤é´Á
      Cells(R, Ci + 1) = ®w¦s
      »Ý¨D = »Ý¨D - ®w¦s
      Ci = Ci + 2
      Data(i) = ¤é´Á & "," & 0
      If i = UBound(Data) And »Ý¨D > 0 Then  '³Ì«á¤@­Ó®w¦s¤]µLªkº¡¨¬¥X³f
        Cells(R, Ci) = "¨S¦³¸ê®Æ"
        Cells(R, Ci + 1) = "¼Æ¶q¤£¨¬"
      End If
    End If
¤U¤@®w¦s:  Next i
¤w¥X³f§¹:  '(¤w¸g0®w¦s ©ÎªÌ º¡¨¬¥X³f»Ý¨D)
  LData = Join(Data, ">")
  D(Key) = LData
  Debug.Print Key & ":" & LData
¤U¤@¬y¤ô¸¹: Next R
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 3# qaqa3296

Sorry, ¦h¤F²Ä2¦æ,½Ð§R¥h¦A¸Õ¡C

TOP

¦^´_ 4# n7822123

·PÁ n7822123 ¤j¤jªº¦^´_

³oµ{¦¡½X¤w¹F¨ì»Ý¨D

¬Ý°_¨Ó²LÅã©öÀ´¡A¥¿¦n¥i¥H¾Ç²ß¤@¤U

#¤]·PÁÂikboy¤j¤jªº¦^´_

§R°£²Ä¤G¦æ¨ÌÂÂ¥X²{¿ù»~

°õ¦æ¶¥¬q¿ù»~'1004':

°»¿ùÅã¬O¦b  .Resize(n, 3) = b ³o¦æ

¦ý§Ú¬Ý¤£À´ikboy¤j¤jªºµ{¦¡½X¡A©Ò¥HµLªk¦Û¦æ°£¿ù

TOP

¤é´Á¥²¶·¬O¥Ñ¤p¦Ó¤j±Æ§Çªº~~
µ{¦¡½X²¤Æ¤£¤F, ºCºC¬Ý§a!
  1. Sub TEST()
  2. Dim Arr, Brr, Crr, xD, i&, k%, R&, C%, »Ý¨D&, ®w¦s&, V&, TR, Mx&
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. Arr = Range([®w¦s!C1], [®w¦s!A65536].End(xlUp))
  5. For i = 2 To UBound(Arr)
  6.     xD(Arr(i, 1)) = Trim(xD(Arr(i, 1)) & " " & i)
  7. Next i
  8. '---------------------------------
  9. Brr = Range([C2], [B65536].End(xlUp))
  10. ReDim Crr(1 To UBound(Brr), 1 To 100)
  11. For i = 1 To UBound(Brr)
  12.     C = 1:  »Ý¨D = Brr(i, 2)
  13.     TR = Split(Trim(xD(Brr(i, 1)) & " 1"), " ")
  14.     For k = 0 To UBound(TR)
  15.         ®w¦s = Val(Arr(TR(k), 3)):   If ®w¦s = 0 Then GoTo k01
  16.         V = IIf(®w¦s < »Ý¨D, ®w¦s, »Ý¨D)
  17.         Crr(i, C) = CDate(Arr(TR(k), 2)):  Crr(i, C + 1) = V
  18.         »Ý¨D = »Ý¨D - V:   ®w¦s = ®w¦s - V:   Arr(TR(k), 3) = ®w¦s
  19.         C = C + 2
  20. k01: Next k
  21.      If »Ý¨D > 0 Then Crr(i, C) = "¨S¦³¸ê®Æ": Crr(i, C + 1) = "¼Æ¶q¤£¨¬"
  22. Next i
  23. [D2].Resize(UBound(Crr), 100) = Crr
  24. End Sub
½Æ»s¥N½X
Xl0000064.rar (14.91 KB)


================================

TOP

µy­×¤@¤U, ­Y¸ê®Æ¸û¦h, ¥i´î¤Ö¤£¥²­nªº°j°é:
Xl0000064-V2.rar (17.54 KB)

TOP

¦^´_ 8# ­ã´£³¡ªL

·PÁ­㴣³¡ªL¤j¤j´£¨Ñ¨ä¥L¤è¦¡

¯àµy·L¸ÑÄÀ·s¼W³o¨â¦æªºÅÞ¿è¶Ü?

If ®w¦s = 0 Then TR(k) = ""
xD(Brr(i, 1)) = Trim(Join(TR, " "))

TOP

¦^´_ 9# qaqa3296

If ®w¦s = 0 Then TR(k) = ""
_¦pªG®w¦s=0, ±N­ì¦³[¦æ¸¹]Åܦ¨ªÅ¦r²Å

xD(Brr(i, 1)) = Trim(Join(TR, " "))
__Join(TR, " ") ­«·s±Nsplitªº°}¦C¥H[ªÅ¥Õ¦r¤¸]²Õ¦¨¦r¦ê
__Trim(Join(TR, " "))...§Q¥ÎTrim¥h±¼¦r¦ê«e«áªºªÅ¥Õ¦r¤¸, Åܦ¨·s¦r¦ê(¦r¦ê·|¶V¨Ó¶Vµu,¬Æ¦Ü¬°ªÅ)

TOP

        ÀR«ä¦Û¦b : ¯à¥I¥X·R¤ß´N¬OºÖ¡A¯à®ø°£·Ð´o´N¬O¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD