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

[µo°Ý] ³sÄòNµ§¸ê®Æ§P§O

[µo°Ý] ³sÄòNµ§¸ê®Æ§P§O

§Ú·Q¼g¤@­Ó§PÂ_«~½èªºµ{¦¡
¤j·§¤º®e¬°±N¼Æ­È»P¤¤¤ß­ÈCL§PÂ_
¦bCÄæ
> CL =1
<CL =0
¥Î¦¹CÄæ§PÂ_
µM«á¦b
DÄæ¦ì¼Ðµù¬O§_³sÄò7µ§¸ê®Æ³£¬O>CL
EÄæ¦ì§PÂ_¬O§_³sÄò7µ§³£¬O³£¬O<CL

=========================µ{¦¡½X==================
Dim side%, QQ%, QQ1%, CL As Variant
k = Cells(Rows.Count, 1).End(xlUp).Row
CL = Range("C1").Value
Range("C3:E" & k).ClearContents


If CL <> "" And k - 1 > 0 Then
    For i = 3 To k
     
     If Range("A" & i) > CL Then
     Range("C" & i) = 1
     Else
     Range("C" & i) = 0
     End If
      
    Next
End If
'==§PÂ_¬O§_³sÄò7µ§¤j©ó©Î¤p©óCL========
For i = 3 To k
        If (Range("C" & i) = 1 And Range("C" & i + 1) = 1 And Range("C" & i + 2) = 1 And Range("C" & i + 3) = 1 And Range("C" & i + 4) = 1 And Range("C" & i + 5) = 1 And Range("C" & i + 6) = 1) Then
        Range("D" & i + 6) = 1
        
        ElseIf (Range("C" & i) = 0 And Range("C" & i + 1) = 0 And Range("C" & i + 2) = 0 And Range("C" & i + 3) = 0 And Range("C" & i + 4) = 0 And Range("C" & i + 5) = 0 And Range("C" & i + 6) = 0) Then
        Range("E" & i + 6) = 1
    End If
Next



QQ = Application.WorksheetFunction.Sum(Range("D3:D" & k))
QQ1 = Application.WorksheetFunction.Sum(Range("E3:E" & k))

If QQ >= 1 Then
MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤j©ó)"
End If

If QQ1 >= 1 Then
MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤p©ó)"
End If

================================================================
§Ú¦b·Q¬O§_¦³§ó¦nªº¼gªk¥Î¨Ó§PÂ_
³sÄò7µ§¸ê®Æ>CL©Î<CL

½Ð¨D«ü¾É
ÁÂÁ¦U¦ì¥ý¶i

Q test.zip (21.42 KB)

²öÅý¥L¤H¿ù»~¶Ë®`¦Û¤v

  1. Sub zz()
  2. Dim a, cl, s$, b(1), k, aa(), n&, m&, r&
  3. a = [a1].CurrentRegion.Resize(, 3)
  4. cl = a(1, 3)
  5. ReDim aa(1 To UBound(a) - 2, 1 To 3)
  6. With CreateObject("vbscript.regexp")
  7.     .Global = True
  8.     For i = 3 To UBound(a)
  9.         If a(i, 1) <= cl Then k = 0 Else k = 1
  10.         aa(i - 2, 1) = k
  11.         s = s & k
  12.     Next
  13.     n = Len(s)
  14.     b(0) = "(1{7," & n & "})"
  15.     b(1) = "(0{7," & n & "})"
  16.     For j = 0 To 1
  17.         .Pattern = b(j)
  18.         s = .Replace(s, "|$1|")
  19.     Next
  20.     k = Split(s, "|")
  21.     n = 0
  22.     For Each t In k
  23.         n = Len(t)
  24.         If n Then
  25.             If n > 6 Then
  26.                 n = Left(t, 1)
  27.                 r = r + 6
  28.                 For i = 7 To Len(t)
  29.                     r = r + 1
  30.                     aa(r, 2 + n) = n
  31.                 Next
  32.             Else
  33.                 r = r + Len(t)
  34.             End If
  35.         End If
  36.     Next
  37. End With
  38. [c3].Resize(UBound(aa), 3) = aa
  39. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-12-31 19:58 ½s¿è

¦^´_ 1# y54161212



¥Î 1 »P -1 µ{¦¡·|²³æÂI¡A1­Ó°j°é§Y¥i·d©w

¥H¤U ¬õ¦âµ{¦¡ ³¡¤À¡A¥u¬O¦C¥X§PÂ_¹Lµ{¡A¥i¦³¥iµL

¤£¼vÅT¸õ«~½è²§±`´£¿ô



Sub §PÂ_«~½è²§±`()
Const N = 7   '³]©w³sÄò¦¸¼Æ
Dim Rn&, R%, S%, T%, CL!
Dim ³sÄò¤j As Boolean, ³sÄò¤p As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
With [A3].Resize(Rn, 5)
  Arr = .Value
  .ClearContents
End With
For R = 1 To Rn
  Arr(R, 3) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Arr(R, 3)
  If S = N Then ³sÄò¤j = True: S = S - 1: Arr(R, 4) = 1
  If S = -N Then ³sÄò¤p = True: S = S + 1: Arr(R, 5) = 1
  If Arr(R, 3) <> T Then T = Arr(R, 3): S = T
Next R
[A3].Resize(Rn, 5) = Arr
If ³sÄò¤j Then MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤j©ó)"
If ³sÄò¤p Then MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤p©ó)"
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¤W­±¨â¦ì¯uªº¬O¤Ó¯«¤F
§Ú§¹¥þ¨S¿ìªk§l¦¬¡]¯º
­n¦n¦nŪ¤@Ū⋯¥b¸ô½ñ¶ivba ÁÙ¯u¦hªF¦è­n°Ý°Ú
²öÅý¥L¤H¿ù»~¶Ë®`¦Û¤v

TOP

¦^ÅU2#¥N½X¦³»~,§ó¥¿¤@¤U
  1. Sub zz()
  2. Dim a, CL, s$, k, t, aa(), n&, m&, r&, Msg(1)
  3. a = [a1].CurrentRegion.Resize(, 3)
  4. CL = a(1, 3)
  5. ReDim aa(1 To UBound(a) - 2, 1 To 3)
  6. With CreateObject("vbscript.regexp")
  7.     .Global = True
  8.     For i = 3 To UBound(a)
  9.         If a(i, 1) <= CL Then k = 0 Else k = 1
  10.         aa(i - 2, 1) = k
  11.         s = s & k
  12.     Next
  13.     .Pattern = "(0{7,}|1{7,})"
  14.     s = .Replace(s, "#$1|")
  15.     k = Split(s, "#")
  16.     For Each t In k
  17.         m = InStr(t, "|")
  18.         If m Then
  19.             m = m - 1 + r
  20.             n = Left(t, 1)
  21.             Msg(n) = n
  22.             i = r + 7
  23.             For j = i To m
  24.                 aa(j, 3 + -n) = 1
  25.             Next
  26.             r = Len(t) - 1
  27.         Else
  28.             r = r + Len(t)
  29.         End If
  30.     Next
  31. End With
  32. [c3].Resize(UBound(aa), 3) = aa
  33. n = Len(Join(Msg, ""))
  34. Select Case n
  35.     Case 1
  36.         MsgBox "³sÄò" & Join(Msg, "") & "¦b¤¤¤ß½u°¼"
  37.     Case 2
  38.         MsgBox "³sÄò" & Join(Msg, "©M") & "¦b¤¤¤ß½u°¼"
  39. End Select
  40. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2021-1-1 11:20 ½s¿è

Sub §PÂ_«~½è²§±`_A()
Dim Arr, Brr, R&, C%, N%(1), X%(1), i&, CL!
R = Cells(Rows.Count, 1).End(xlUp).Row - 2
If R < 1 Then Exit Sub
CL = [C1]
Arr = [A3].Resize(R)
ReDim Brr(1 To R, 1 To 4)
For i = 1 To R
    C = -(Arr(i, 1) > CL): Brr(i, 1) = C
    N(C) = N(C) + 1: N(1 - C) = 0
    If N(C) >= 7 Then Brr(i, 3 - C) = 1: X(C) = 1
Next i
[C3].Resize(R, 4) = Brr
If X(1) Then MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤j©ó)"
If X(0) Then MsgBox "³sÄò7ÂI¦b¤¤¤ß½u¦P°¼(¤p©ó)"
End Sub


'================================

TOP

D3//¥k©Ô/¤U©Ô
=IF(COUNTIF(OFFSET($A3,,,-MIN(ROW(A1),7)),IF(COLUMN(A1)=1,">","<=")&$C$1)>6,1,"")

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2021-1-1 14:20 ½s¿è

¦^´_ 4# y54161212

¤W­±¨â¦ì¯uªº¬O¤Ó¯«¤F
§Ú§¹¥þ¨S¿ìªk§l¦¬¡]¯º

§Úı±o§Ú¼gªº«Üª½Ä±ªü¡A´N§PÂ_¦¨1 , -1 ¦b¥[Á`¦Ó¤w

ikboy ªº¥¿³Wªí¥Üªk §Ú¤]¤£¬O«ÜÀ´XD

§A¤]¥i¥H°Ñ¦Ò·Ç¤jªº¡A¥L¬O¥Î¨â­ÓÅܼƤÀ§O¥[Á`¡@

N(1)¬ö¿ý¤j©óCL¦¸¼Æ
N(0)¬ö¿ý¤p©óCL¦¸¼Æ



j§Úªºµ{¦¡¡A¦pªG­nÂX®i¨ì8¦¸¡B9¦¸¡A§ïN­È§Y¥i

¨q¥Xªº°T®§¨S§ï¨ì¡A­×§ï¦p¤U


Sub §PÂ_«~½è²§±`()
Const N = 7   '³]©w³sÄò¦¸¼Æ
Dim Rn&, R%, S%, T%, CL!
Dim ³sÄò¤j As Boolean, ³sÄò¤p As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
With [A3].Resize(Rn, 5)
  Arr = .Value
  .ClearContents
End With
For R = 1 To Rn
  Arr(R, 3) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Arr(R, 3)
  If S = N Then ³sÄò¤j = True: S = S - 1: Arr(R, 4) = 1
  If S = -N Then ³sÄò¤p = True: S = S + 1: Arr(R, 5) = 1
  If Arr(R, 3) <> T Then T = Arr(R, 3): S = T
Next R
[A3].Resize(Rn, 5) = Arr
If ³sÄò¤j Then MsgBox "³sÄò" & N & "ÂI¦b¤¤¤ß½u¦P°¼(¤j©ó)"
If ³sÄò¤p Then MsgBox "³sÄò" & N & "ÂI¦b¤¤¤ß½u¦P°¼(¤p©ó)"
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 8# n7822123


With [A3].Resize(Rn, 5)
  Arr = .Value '¤­Äæ¸ê®Æ¦s¤J°}¦C
  .ClearContents '²M°£­ì¦³¸ê®Æ, ¦ý­ì¸ê®ÆÁÙ¦b°}¦C¤¤, ·í°}¦C¶K¦^®É, ÁÙ·|¦³´Ý¯d, ¥i­×§ïaÄæ°Ñ¼Æ¤£§ó°Ê¨ä¥¦¦C¸ê®Æ¸Õ¸Õ
End With

¥t¥~, ¾¨¶q¤£­n²MªÅ­ì¼Æ¾Ú, ÁקKµ{¦¡¦]¿ù»~¤¤Â_¦Ó¿ò¥¢¸ê®Æ,
¦Ó¥B, ¶K¦^®É, ¤]À³­­¨î¦bÅÜ°Ê°Ï, ¦ÓÁקK¥þ°Ï¶K¦^, ­Y¸ê®ÆÃe¤j«h¶·ªá¶O¦^¼g¶ñº¡ªº®É¶¡


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

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2021-1-1 16:44 ½s¿è

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

·PÁ·ǤjªÈ¥¿XD

¨ä¹ê§Ú¤wµo²{°ÝÃD¤F¡A¥u¬OÃiªº§ï~

·Q»¡Åª¸ê®Æ»P¼g¸ê®Æ³£¥Î¦P¤@­Ó°}¦C¸Ñ¨M´N¦n

¦ý¬O·|§â«e¤@¦¸ªº§PÂ_­È¤]¼g¤JArr (·|«O¯d«e¤@¦¸§PÂ_¹Lµ{)

¬JµM·Ç¤jªÈ¥¿¤F¡A¨º§ÚÁÙ¬O©î¦¨2­Ó°}¦C¦n¤F~

¥t¥~¡A¯¬ ·Ç¤j ·s¦~§Ö¼Ö ^.^


Sub §PÂ_«~½è²§±`()
Const N = 8   '³]©w³sÄò¦¸¼Æ
Dim Rn&, R%, S%, T%, CL!, Arr, Brr
Dim ³sÄò¤j As Boolean, ³sÄò¤p As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
Arr = [A3].Resize(Rn)
[C3].Resize(Rn, 3).ClearContents
ReDim Brr(1 To Rn, 1 To 3)

For R = 1 To Rn
  Brr(R, 1) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Brr(R, 1)
  If S = N Then ³sÄò¤j = True: S = S - 1: Brr(R, 2) = 1
  If S = -N Then ³sÄò¤p = True: S = S + 1: Brr(R, 3) = 1
  If Brr(R, 1) <> T Then T = Brr(R, 1): S = T
Next R
[C3].Resize(Rn, 3) = Brr
If ³sÄò¤j Then MsgBox "³sÄò" & N & "ÂI¦b¤¤¤ß½u¦P°¼(¤j©ó)"
If ³sÄò¤p Then MsgBox "³sÄò" & N & "ÂI¦b¤¤¤ß½u¦P°¼(¤p©ó)"
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

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