Andy2483

¦^´_ 1# jomeow


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ßVBA°}¦C,½m²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Crr, v&, Q%, i&, j%, R&, c%, M&, A%, K&
K = 2000: Brr = Range([A1], ActiveSheet.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
[J:Z].ClearContents
[J1].Resize(M, c - 1) = Crr
Erase Brr, Crr
End Sub

Andy2483

¦^´_ 7# jomeow


    ¦b½×¾Â¤WÄ~Äò°µ°Q½×,«á¾Çª¾µL¤£¨¥

Andy2483

¦^´_ 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

Andy2483

¦^´_ 12# jomeow


    ¤U¤È¼·ªÅ½Æ²ß¦Aµù¸Ñµ¹°Ñ¦Ò

Andy2483

¦^´_ 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

Andy2483

¦^´_ 22# jomeow


    ¨âªÌ»Ý¨D±¡¹Ò¤£¤@¼Ë,§ÚªºVBA°õ¦æµ²ªG¦P1¼Ó¹Ï¤ùªº³W«h,»P hcm19522«e½úªº¨ç¼Æ³W«h¤£¦P

Andy2483

¦^´_ 24# jomeow


   
1¼Ó½d¨Ò»P¹Ï¤ù¦³¤@­Ó¯S§O³B:
¦pªG ²Ö¥[¤~­è¦n¬O2000´N¤£¦A¥[Á`«á­±ªº¼Æ­È,¶ñ¤J2000,
¥tªì©l­È¬O2000ªº«o­nÄ~Äò²Ö¥[
³o«Ü¯S§O
«á¾Ç¤]¬Oé¨ì­è¦n¸ò½d¨Ò¬Û¦Pªºµ²ªG
©Ò¥H»Ý­n½T©w²M·¡±zªº»Ý¨D

Andy2483

¦^´_ 27# jomeow


If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then

§ï¦¨

If (v > K) + (Q = 1 And v > 0) < 0 Then

Andy2483

¦^´_ 27# jomeow

¤U¸ü (91.85 KB)

2023-10-26 07:55

¿é¤Jµ¡¿é¤J0ªº°õ¦æµ²ªG:

¤U¸ü (50.41 KB)

2023-10-26 07:59

¿é¤Jµ¡¿é¤J1ªº°õ¦æµ²ªG:

¤U¸ü (50.58 KB)

2023-10-26 07:59

   
Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, i&, R&, K&, M&, j%, Q%, c%, A%, Ss As Worksheet, Sa As Worksheet, iBox
'¡ô«Å§iÅܼÆ:(Brr,Crr,iBox)¬O³q¥Î«¬ÅܼÆ,(v,i,R,K,M)¬Oªø¾ã¼Æ,(j,Q,c,A)¬Oµu¾ã¼Æ
'(Ss,Sa)¬O¤u§@ªíÅܼÆ
iBox = InputBox("0¬O¤£¨¬2000Ä~Äò²Ö¥[!" & vbLf & "1¬O²Ö¥[­è¦n¬O2000ªº¤£¦A²Ö¥[", "½Ð¿é¤J0 ©Î1", 0)
'¡ô¥OiBox³o³q¥Î«¬ÅܼƬO ¿é¤Jµ¡¦^¶Ç­È
If StrPtr(iBox) = 0 Then Exit Sub Else iBox = IIf(Val(iBox) > 0, 1, 0)
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¥ª¦³½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) * iBox + (v > K) + (Q = 1 And v > 0) < 0 Then
      '¡ô¦pªG(vÅܼƬO­è¦n2000,¦Ó¥B¬O²Ö¥[¤~­è¦n¬O2000¥B¿é¤J¬O1),©Î
      '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­È
Application.Goto Sa.[B22].Resize(M, c - 1)
'¡ô¥Oµøµ¡¸õ¨ìµ²ªG¦ì¸m
Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub