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

[µo°Ý] ½Ð±Ð¦p¦óÅývba¦Û°Ê§PÂ_¿z¿ï³Ì¤j­È»P³Ì¤p­È

[µo°Ý] ½Ð±Ð¦p¦óÅývba¦Û°Ê§PÂ_¿z¿ï³Ì¤j­È»P³Ì¤p­È

½Ð°Ý¦Ñ®v:
¦p¦óÅýVBA¦Û°Ê§PÂ_¿z¿ïK3~K21ªº³Ì¤j­È,¿z¿ï«á±N¿z¿ïµ²ªG«þ¨©¨ì³Ì¤j­È¤u§@ªíA1ªº¦ì¸m
¦AÅýVBA¦Û°Ê§PÂ_¿z¿ïK3~K21ªº³Ì¤p­È,¿z¿ï«á±N¿z¿ïµ²ªG«þ¨©¨ì³Ì¤p­È¤u§@ªíA1ªº¦ì¸m¡CÁÂÁÂ

YY.rar (8.88 KB)

¿z¿ï³Ì¤j³Ì¤p­È

·PÁ¦U¦ì¦Ñ®vªá¤ß«ä±Ð¾É

dear sir
    ¦p¤U¸Õ¸Õ     sheet1=source  
                  sheet2=³Ì¤j­È¤u§@ªí
                              sheet3=³Ì¤p­È¤u§@ªí
Sub AA()
Sheet1.Select
   mymax = Evaluate("max(K3:K21)")
   mymin = Evaluate("min(K3:K21)")
   Sheet2.Range("a1") = mymax
   Sheet3.Range("a1") = mymin
End Sub
ù

TOP

¦^´_ 2# rouber590324
¼Ó¥DÀ³¸Ó¬O´Á±æ¦p¦¹ªº
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Object, Rng As Range, R As Range
  4.     Dim xMax As Single, xMin As Single
  5.     Set D = CreateObject("SCRIPTING.DICTIONARY")    '¦r¨åª«¥ó
  6.     Set Rng = Sheets("¸ê®Æ").[I3:O21]               '¸ê®Æ½d³ò
  7.     xMax = Application.Max(Rng.Columns(3))          '²Ä3Äæ(kÄæ)ªº³Ì¤j­È
  8.     xMin = Application.Min(Rng.Columns(3))          '²Ä3Äæ(kÄæ)ªº³Ì¤p­È
  9.     For Each R In Rng.Rows                          '¸ê®Æ½d³ò(ª«¥ó)ªº¦C(ª«¥ó)
  10.         If R.Cells(3) = xMax Then                   '¬O³Ì¤j­Èªº¼Æ­È
  11.             If D.exists(xMax) Then                  '¦r¨åª«¥óªºkey(ÃöÁä¦r)¬O¦s¦bªº
  12.                 Set D(xMax) = Union(R, D(xMax))     'Union:¨â­Ó©Î¦h­Ó½d³òªº¦X¨Ö½d³ò¡C
  13.             Else
  14.                 Set D(xMax) = R                     '³]©w½d³ò
  15.             End If
  16.         ElseIf R.Cells(3) = xMin Then               '¬O³Ì¤p­Èªº¼Æ­È
  17.             If D.exists(xMin) Then
  18.                 Set D(xMin) = Union(R, D(xMin))
  19.             Else
  20.                 Set D(xMin) = R
  21.             End If
  22.         End If
  23.     Next
  24.     D(xMax).Copy Sheets("³Ì¤j­È").[a1]
  25.     D(xMin).Copy Sheets("³Ì¤p­È").[a1]
  26. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# GBKEE

GBKEE ¦Ñ®v:
±zªº¤è¦¡¡A¥¿¬O¤p§Ì©Ò»Ý­nªº¡A¥B±zÁÙÀ°¦£°µµù¸Ñ¡AÅý§Ú¯à§ó²M·¡¦p¦ó¹B¥Î¡A·PÁ±zªº«ü¾É¡AÁÂÁ¡C
·PÁ¦U¦ì¦Ñ®vªá¤ß«ä±Ð¾É

TOP

¦^´_ 2# rouber590324
rouber590324¦Ñ®v:
±zªº¤è¦¡¤]¬O¥i¦æ¡A¥u¬O¤£¬O¤p§Ì©Ò»Ý­n¥Î¨ìªº¡A¦ý¤]·PÁ±zÄ@·N¼·ªÅ«ü¾É¡AÁÂÁÂ
·PÁ¦U¦ì¦Ñ®vªá¤ß«ä±Ð¾É

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-4-19 14:42 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:


°õ¦æµ²ªG("³Ì¤j­È" ¤u§@ªí):
20230419_2.jpg

°õ¦æµ²ªG("³Ì¤p­È" ¤u§@ªí):
20230419_3.jpg


Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100, 1 To 7), Y, R1&, R2&, i&, T, P$, Min&, Max&
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("¸ê®Æ"): Set Sh2 = Sheets("³Ì¤j­È"): Set Sh3 = Sheets("³Ì¤p­È")
Sh2.UsedRange.Delete: Sh3.UsedRange.Delete
Set xR = Range(Sh1.[O3], Sh1.Cells(Rows.Count, "I").End(xlUp)): Brr = xR
For i = 1 To UBound(Brr)
   T = Val(Brr(i, 3)): Y(T & "|" & i) = i
   If IsEmpty(Min) Or Min > T Then Min = T
   If IsEmpty(Max) Or T > Max Then Max = T
Next
For Each T In Y.keys
   If Val(T) = Max Then
      R1 = R1 + 1: For i = 1 To 7: Brr(R1, i) = Brr(Y(T), i): Next
   End If
   If Val(T) = Min Then
      R2 = R2 + 1: For i = 1 To 7: Crr(R2, i) = Brr(Y(T), i): Next
   End If
Next
Sh2.[A1].Resize(R1, 7) = Brr: Sh3.[A1].Resize(R2, 7) = Crr
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
Set Sh1 = Nothing: Set Sh2 = Nothing: Set Sh3 = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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