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

[µo°Ý] ➽¿z¿ïGÄæ>HÄæ>IÄæ

  1. Sub zz()
  2. Dim rng As Range, a, b, i&, j&, k&, n&, m&
  3. With Sheets(1)
  4.     Set rng = .Range("c2:l" & .[b2].End(4).Row)
  5.     a = rng.Value: b = a
  6. End With
  7. j = rng(1).Column - 1
  8. c = Split(InputBox("¿é¤J¦C¸¹¥H¨§¸¹¶¡¶}", , "G,H,I"), ",")
  9. For i = 0 To UBound(c)
  10.     c(i) = Columns(c(i)).Column - j
  11. Next
  12. n = UBound(c): m = 1
  13. For i = 2 To UBound(a)
  14.     k = 0
  15.     For j = 0 To n - 1
  16.         If a(i, c(j)) > a(i, c(j + 1)) Then k = k + 1
  17.     Next
  18.     If k = n Then
  19.         m = m + 1
  20.         For j = 1 To UBound(a, 2)
  21.             b(n, j) = a(i, j)
  22.         Next
  23.     End If
  24. Next
  25. With Sheets(2)
  26.     .UsedRange.Clear
  27.     .[a1].Resize(m, UBound(b, 2)) = b
  28. End With
  29. End Sub
½Æ»s¥N½X

TOP

¦^´_ 10# peter95

¥u¬O¤j©ó & ¤p©óªºÅܧó,À³¸Ó¨S³o»ò§xÃø§a!
    If arr(x, 7) < arr(x, 8) And arr(x, 8) < arr(x, 9) And arr(x, 9) < arr(x, 10) Then Set c = Union(c, arr(x, 3).Resize(, 10))

TOP

¦^´_ 10# peter95
  1. Sub zz()
  2. Dim rng As Range, a, b, i&, j&, k&, n&, m&, s
  3. With Sheets(1)
  4.     Set rng = .Range("c2:l" & .[b2].End(4).Row)
  5.     a = rng.Value: b = a
  6. End With
  7. j = rng(1).Column - 1
  8. c = InputBox("¿é¤J¦C¸¹¥H¤ñ¸û¸¹¶¡¶}", , "G<H<I")
  9. s = Mid(c, 2, 1): c = Split(c, s)
  10. For i = 0 To UBound(c)
  11.     c(i) = Columns(c(i)).Column - j
  12. Next
  13. n = UBound(c): m = 1
  14. For i = 2 To UBound(a)
  15.     k = 0
  16.     If s = "<" Then Call L(a, i, c, n, k) Else Call G(a, i, c, n, k)
  17.     If k = n Then
  18.         m = m + 1
  19.         For j = 1 To UBound(a, 2)
  20.             b(n, j) = a(i, j)
  21.         Next
  22.     End If
  23. Next
  24. With Sheets(2)
  25.     .UsedRange.Clear
  26.     .[a1].Resize(m, UBound(b, 2)) = b
  27. End With
  28. End Sub
½Æ»s¥N½X
  1. Sub G(a, i, c, n, k)
  2.     For j = 0 To n - 1
  3.         If a(i, c(j)) > a(i, c(j + 1)) Then k = k + 1
  4.     Next
  5. End Sub
½Æ»s¥N½X
  1. Sub L(a, i, c, n, k)
  2.     For j = 0 To n - 1
  3.         If a(i, c(j)) < a(i, c(j + 1)) Then k = k + 1
  4.     Next
  5. End Sub
½Æ»s¥N½X

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¥H1#½d¨Ò½m²ßÀx¦s®æÁp¶°,ÂX±i»P¥æ¶°,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Dim i&, xA As Range, xU As Range
Set xA = Range([Sheet1!L2], [Sheet1!C65536].End(3))
Set xU = xA(1)
For i = 2 To xA.Rows.Count
   If (Val(xA(i, 5)) > Val(xA(i, 6))) * (Val(xA(i, 6)) > Val(xA(i, 7))) = 1 Then
      Set xU = Union(xU, xA(i, 1))
   End If
Next
Intersect(xU.EntireRow, [Sheet1!C:L]).Copy [¤u§@ªí1!A1]
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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