麻辣家族討論版版 » Excel程式區 » ➽篩選G欄>H欄>I欄

返回列表下一主題上一主題發帖

[發問] ➽篩選G欄>H欄>I欄

中學生 Rank: 2

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2020-11-15 00:39 | 只看該作者

[發問] ➽篩選G欄>H欄>I欄

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

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

非常感謝大家幫忙,謝謝

附上說明圖片

檔案資料

QQ.rar (80.7 KB)

樓主熱帖

收藏

學習學習一直學習

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1481
主題: 40
精華: 0
積分: 1505
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-10-27

14^#

發表於 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

13^#

發表於 2020-11-18 14:35 | 只看該作者

回復 10# peter95

Sub zz()
Dim rng As Range, a, b, i&, j&, k&, n&, m&, s
With Sheets(1)
Set rng = .Range("c2:l" & .[b2].End(4).Row)
a = rng.Value: b = a
End With
j = rng(1).Column - 1
c = InputBox("輸入列號以比較號間開", , "G<H<I")
s = Mid(c, 2, 1): c = Split(c, s)
For i = 0 To UBound(c)
c(i) = Columns(c(i)).Column - j
Next
n = UBound(c): m = 1
For i = 2 To UBound(a)
k = 0
If s = "<" Then Call L(a, i, c, n, k) Else Call G(a, i, c, n, k)
If k = n Then
m = m + 1
For j = 1 To UBound(a, 2)
b(n, j) = a(i, j)
Next
End If
Next
With Sheets(2)
.UsedRange.Clear
.[a1].Resize(m, UBound(b, 2)) = b
End With
End Sub

複製代碼

Sub G(a, i, c, n, k)
For j = 0 To n - 1
If a(i, c(j)) > a(i, c(j + 1)) Then k = k + 1
Next
End Sub

複製代碼

Sub L(a, i, c, n, k)
For j = 0 To n - 1
If a(i, c(j)) < a(i, c(j + 1)) Then k = k + 1
Next
End Sub

複製代碼

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

12^#

發表於 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))

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

11^#

發表於 2020-11-18 10:05 | 只看該作者

Sub zz()
Dim rng As Range, a, b, i&, j&, k&, n&, m&
With Sheets(1)
Set rng = .Range("c2:l" & .[b2].End(4).Row)
a = rng.Value: b = a
End With
j = rng(1).Column - 1
c = Split(InputBox("輸入列號以豆號間開", , "G,H,I"), ",")
For i = 0 To UBound(c)
c(i) = Columns(c(i)).Column - j
Next
n = UBound(c): m = 1
For i = 2 To UBound(a)
k = 0
For j = 0 To n - 1
If a(i, c(j)) > a(i, c(j + 1)) Then k = k + 1
Next
If k = n Then
m = m + 1
For j = 1 To UBound(a, 2)
b(n, j) = a(i, j)
Next
End If
Next
With Sheets(2)
.UsedRange.Clear
.[a1].Resize(m, UBound(b, 2)) = b
End With
End Sub

複製代碼

中學生 Rank: 2

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

10^#

發表於 2020-11-18 00:05 | 只看該作者

回復 9# jcchiang

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

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

請問我該如何更改語法
謝謝大大幫忙

學習學習一直學習

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

9^#

發表於 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))

中學生 Rank: 2

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

8^#

發表於 2020-11-16 21:54 | 只看該作者

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

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

請問我該如何更改語法
謝謝大大幫忙

學習學習一直學習

中學生 Rank: 2

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

7^#

發表於 2020-11-16 21:26 | 只看該作者

感謝麻辣家族討論眾多神人
的熱情幫忙
謝謝大家
有你們真好

學習學習一直學習

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

6^#

發表於 2020-11-16 13:09 | 只看該作者

回復 5# 准提部林

感謝准大指導，謝謝。

靜思自在 : 屋寬不如心寬。

返回列表下一主題上一主題