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

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

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

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

中學生 Rank: 2

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

2016猴年全勤獎章

1^# 跳轉到 »

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

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

2016猴年全勤獎章

2^#

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

複製代碼

靜思自在 : 話多不如話少，話少不如話好。

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