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

¤£¦P¯Å§O¥[Á`°ÝÃD

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-10-24 11:58 ½s¿è

¦^´_ 10# jomeow


   
[calculation!B22:F30].ClearContents
[calculation!B22].Resize(M, c - 1) = Crr
======================================


©ú½T«ü¦V¸ê®Æªí»Pµ²ªGªí ª©¥»

Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, Q%, i&, j%, R&, c%, M&, A%, K&, Ss As Worksheet, Sa As Worksheet
Set Ss = Sheets("data input"): Set Sa = Sheets("calculation")
K = 2000: Brr = Range(Ss.[A1], Ss.UsedRange.Offset(1, 0))
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
For j = 2 To UBound(Brr, 2)
   c = c + 1: R = 0: Q = 0
   If Brr(2, j) Like "BM *" = False Then Exit For
   If Brr(3, j) = "" Then GoTo j01
   For i = 3 To UBound(Brr)
      v = v + Val(Brr(i, j)): A = A + 1
      If Trim(Brr(i + 1, j)) = "" Then Q = 1
      If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
         R = R + 1: Crr(R, c) = v: v = 0: A = 0
      End If
      If Q = 1 Then Exit For
   Next
   If M < R Then M = R
j01: Next
If M = 0 Then Exit Sub
Sa.[B22:F30].ClearContents
Sa.[B22].Resize(M, c - 1) = Crr
Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 11# Andy2483


ÁÂÁ¤j¤jªº¥X¤âÀ°¦£!

½Ð°Ý¦p¦³ªÅ.. ¥i¤£¥i¥H«ü±Ð¤@¤U§Úvba¤º®eªº¼gªk¥i¥H¶Ü?

¦]¬°.. §Ú°Ý¤F«Ü¦h­Ó¸s,, ¥u¦³§Aªºµª®×¤~¥¿½T...

·P®¦§AªºÀ°§U

TOP

¦^´_ 5# jomeow


    ¼Æ²Õ¤½¦¡ :½Æ»s¤½¦¡ ¤£§t "=" ,¶K¤W«á¥[ "="   ;³Ì«e "{" ¥Nªí shift+ctrl+enter ¤TÁä¤@°_«ö©Ò²£¥Í ,«Dµ{¦¡¸Ì­±
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 12# jomeow


    ¤U¤È¼·ªÅ½Æ²ß¦Aµù¸Ñµ¹°Ñ¦Ò
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 13# hcm19522

ÁÂÁ¤j¤jªº¸ÑÄÀ... ²{¦b©ú¥Õ¦h¤F..

TOP

¦^´_ 14# Andy2483


    ÁÂÁ§A~

TOP

¦^´_ 11# Andy2483


    «D±`¦³¥Î... ·PÁÂ~

¤£¹L§Ú­è¤~´N¥Î¤F§A­×§ïªº¨â¦æ, ¤]¦¨¥\¤F..

TOP

¦^´_ 13# hcm19522


§A±Ð§Úªº¤½¦¡.. §Ú¦¨¥\¤F...

«D±`·PÁ§AªºÀ°§U...

m(_ _)m

§A­Ì³£«Ü¼F®`.. ¥i¤£¥i¥HÅý§Ú»{ÃѧA¶Ü

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-10-24 13:37 ½s¿è

¦^´_ 16# jomeow


    ÁÂÁ¤W½×¾Â¤@°_¾Ç²ß
Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, i&, R&, K&, M&, j%, Q%, c%, A%, Ss As Worksheet, Sa As Worksheet
'¡ô«Å§iÅܼÆ:(Brr, Crr)¬O³q¥Î«¬ÅܼÆ,(v,i,R,K,M)¬Oªø¾ã¼Æ,(j,Q,c,A)¬Oµu¾ã¼Æ
'(Ss,Sa)¬O¤u§@ªíÅܼÆ
Set Ss = Sheets("data input"): Set Sa = Sheets("calculation")
'¡ô¥OSs³o¤u§@ªíÅܼƸ˲± ¤u§@ªí "data input"
'¡ô¥OSa³o¤u§@ªíÅܼƸ˲± ¤u§@ªí "calculation"

K = 2000: Brr = Range(Ss.[A1], Ss.UsedRange.Offset(1, 0))
'¡ô¥OK³oªø¾ã¼ÆÅܼƬO±`¼Æ2000
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥HSsÅܼƪº[A1]¨ì¤w¨Ï¥ÎÀx¦s®æ¤U°¾²¾¤@¦C,
'³o½d³òÀx¦s®æ­È±a¤JBrr°}¦C¤¤

ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
'¡ô«Å§i³oCrr³q¥Î«¬ÅܼƬO¤GºûªÅ°}¦C:
'°}¦C¤W¤U½d³ò±q¯Á¤Þ¸¹1¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
'°}¦C¥ª¥k½d³ò±q¯Á¤Þ¸¹1¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹

For j = 2 To UBound(Brr, 2)
'¡ô³]¶¶°j°éj:±q2¨ì Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
   c = c + 1: R = 0: Q = 0
   '¡ô¥Oc³oµu¾ã¼ÆÅܼƲ֥[1
   '¡ô¥OR³oªø¾ã¼ÆÂk¹s,¥OQ³oªø¾ã¼Æ¤]Âk¹s

   If Brr(2, j) Like "BM *" = False Then Exit For
   '¡ô¦pªG²Ä2¦Cj°j°éÄæBrr°}¦C­È¤£¬O¥H BM ¦r¦ê¶}ÀY!´Nµ²§ôjªº°j°é
   If Brr(3, j) = "" Then GoTo j01
   '¡ô¦pªG²Ä3¦Cj°j°éÄæBrr°}¦C­È¬OªÅ¦r¤¸!´N¸õ¨ì¼Ð¥Ü j01¦ì¸mÄ~Äò°õ¦æ
   For i = 3 To UBound(Brr)
   '¡ô³]¶¶°j°éi:±q3¨ì Brr°}¦Cºî¦V³Ì¤j¯Á¤Þ¦C¸¹
      v = v + Val(Brr(i, j)): A = A + 1
      '¡ô¥Ov³oªø¾ã¼ÆÅܼƲ֥[(i°j°é¦C/j°j°éÄæBrr°}¦C­È)Âà¤Æªº¼Æ­È
      If Trim(Brr(i + 1, j)) = "" Then Q = 1
      '¡ô¦pªG¤U¤@­Ó°j°é°}¦C­È¬O ªÅ¦r¤¸!´N¥OQÅܼƬO1
      If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
      '¡ô¦pªG(vÅܼƬO­è¦n2000,¦Ó¥B¬O²Ö¥[¤~­è¦n¬O2000ªº),©Î
      'vÅܼƤj©ó 2000,©Îv¤j©ó0 ¥B¤w¸g¬O¸ÓÄæ³Ì«á¤@­Ó¼Æ­È,
      '¦pªG¥H¤W¤TºØ±ø¥óªº¨ä¤¤¤@ºØ±ø¥ó¦¨¥ß!

         R = R + 1: Crr(R, c) = v: v = 0: A = 0
         '¡ô¥ORÅܼƲ֥[1
         '¡ô¥ORÅܼƦCcÅܼÆÄæCrr°}¦C­È¬OvÅܼÆ
         '¡ô¥OvÅܼÆÂk¹s,AÅܼƤ]Âk¹s

      End If
      If Q = 1 Then Exit For
      '¡ô¦pªGQÅܼƬO1!´Nµ²§ôi°j°é
   Next
   If M < R Then M = R
   '¡ô¦pªGMÅܼƤp©óRÅܼÆ!´N¥OMÅÜ¼Æ µ¥©óRÅܼÆ
j01: Next
If M = 0 Then Exit Sub
'¡ô¦pªGMÅܼƬO0!´Nµ²§ôµ{¦¡°õ¦æ
Sa.[B22:F30].ClearContents
'¡ô¥OSaÅܼƪº[B22:F30]Àx¦s®æ²M°£¤º®e
Sa.[B22].Resize(M, c - 1) = Crr
'¡ô¥OSaÅܼƪº[B22]¦V¤UÂX®iMÅܼƦC,¦V¥kÂX®i(c-1)Äæ,
'³o½d³òÀx¦s®æ­È¬OCrr°}¦C­È

Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 19# Andy2483


¦n¸Ô²Ó... §Ú­nºCºC¾Ç²ß¤@¤U...

@o@

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD