Board logo

標題: [發問] ➽篩選G欄>H欄>I欄 [打印本頁]
作者: peter95    時間: 2020-11-15 00:39     標題: ➽篩選G欄>H欄>I欄

每次都需篩選400筆資料
條件如下:

篩選G欄>H欄>I欄               
篩選完後,將資料儲存在-工作表1

非常感謝大家幫忙,謝謝

附上說明圖片
[attach]32691[/attach]

檔案資料
[attach]32692[/attach]
作者: hcm19522    時間: 2020-11-15 10:37

本帖最後由 hcm19522 於 2024-1-25 10:32 編輯

(輸入編號12335) google網址:https://draft.blogger.com/blog/posts/9094075214774179359
作者: samwang    時間: 2020-11-16 07:47

回復 1# peter95
Sub test()
Dim Arr, i&, T$, T1$, T2$, k%, Brr(1 To 10000, 1 To 10)
Arr = Range([sheet1!L2], [sheet1!C65536].End(xlUp))
    For i = 2 To UBound(Arr)
        T = Arr(i, 5): T1 = Arr(i, 6): T2 = Arr(i, 7)
        If Arr(i, 5) = "" Then GoTo 100
        If T > T1 And T1 > T2 Then
            k = k + 1
            Brr(k, 1) = Arr(i, 1): Brr(k, 2) = Arr(i, 2)
            Brr(k, 3) = Arr(i, 3): Brr(k, 4) = Arr(i, 4)
            Brr(k, 5) = Arr(i, 5): Brr(k, 6) = Arr(i, 6)
            Brr(k, 7) = Arr(i, 7): Brr(k, 8) = Arr(i, 8)
            Brr(k, 9) = Arr(i, 9): Brr(k, 10) = Arr(i, 10)
        End If
100: Next
[工作表1!A1:J1] = Array("編號", "產品", "類別", "D", "1", "2", "3", "4", "5", "6")
[工作表1!A2].Resize(k, 10) = Brr
End Sub
作者: jcchiang    時間: 2020-11-16 08:23

回復 1# peter95

Sub ex()
Dim arr, c, x%
With Sheets("Sheet1")
Set c = .Range(.[c2], .[l2])
Set arr = .[c2].CurrentRegion
For x = 2 To arr.Rows.Count
   If arr(x, 7) > arr(x, 8) And arr(x, 8) > arr(x, 9) Then Set c = Union(c, arr(x, 3).Resize(, 10))
Next
End With
c.Copy Sheets("工作表1").[a1]
End Sub
作者: 准提部林    時間: 2020-11-16 11:54

回復 3# samwang

GHI欄為數值格式
T$ 是文字格式(String), 用來比對大小會有問題, 例如:"10.3" 會被判比 "9.5"小
直接 DIM T, T1, T2 即可
作者: samwang    時間: 2020-11-16 13:09

回復 5# 准提部林

感謝准大指導，謝謝。
作者: peter95    時間: 2020-11-16 21:26

感謝 麻辣家族討論  眾多神人
的熱情幫忙
謝謝大家
有你們真好
作者: peter95    時間: 2020-11-16 21:54

回復 4# jcchiang
感謝大大幫忙 經測試 可以使用

若小弟想變為 篩選G欄>H欄>I欄>J欄               
篩選完後,將資料儲存在-工作表1

請問我該如何更改 語法
謝謝大大幫忙
作者: jcchiang    時間: 2020-11-17 08:06

回復 8# peter95


    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))
作者: peter95    時間: 2020-11-18 00:05

回復 9# jcchiang

感謝大大幫忙 經測試 可以使用

若小弟想變為 篩選G欄<H欄<I欄<J欄               
篩選完後,將資料儲存在-工作表1

請問我該如何更改 語法
謝謝大大幫忙
作者: ikboy    時間: 2020-11-18 10:05

  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("輸入列號以豆號間開", , "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
複製代碼
作者: jcchiang    時間: 2020-11-18 12:23

回復 10# peter95

只是大於 & 小於的變更,應該沒這麼困難吧!
    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))
作者: ikboy    時間: 2020-11-18 14:35

回復 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("輸入列號以比較號間開", , "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
複製代碼
  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
複製代碼
  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
複製代碼
作者: Andy2483    時間: 2024-1-25 09:53

謝謝論壇,謝謝各位前輩
後學藉此帖以1#範例練習儲存格聯集,擴張與交集,學習方案如下,請各位前輩指教

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 [工作表1!A1]
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)