求助：从表1中，用vba筛选出边压在4000-8000的数据，表2中显示

2217918 · 发表于 2023-4-23 22:43

本帖最后由 2217918 于 2023-4-23 22:45 编辑

求助：从表1中，用vba筛选出边压在4000-8000的数据，表2中显示，按照边压从小到大进行往下排

不知道为什么 · 发表于 2023-4-23 22:58

如图参考

2217918 · 发表于 2023-4-23 23:01

不知道为什么发表于 2023-4-23 22:58
如图参考

非常感谢，谢谢老师！

zxsea_7426 · 发表于 2023-4-23 23:19

复制全表，删除不符合要求的数据，并从大到小排序

Sub 筛选()
Dim rngs As Range
With Sheet2
Sheet1.Cells.Copy .[a1]
r = .Cells(Rows.Count, "B").End(3).Row
.Range(.[b8], .Cells(r, "J")).Sort key1:=.[b8].Offset(0, 8), order1:=2, Header:=xlNo
ar = .Range(.[b8], .Cells(r, "J"))
For i = 1 To UBound(ar)
If ar(i, 9) < 4000 Or ar(i, 9) > 8000 Then
If rngs Is Nothing Then
Set rngs = .Rows(i + 7)
Else
Set rngs = Union(rngs, .Rows(i + 7))
End If
End If
Next i
If Not rngs Is Nothing Then
rngs.Delete
End If
End With
End Sub

复制代码

zxsea_7426 · 发表于 2023-4-23 23:24

楼上代码排序反过来了，修正一下:

Sub 筛选()
Dim rngs As Range
With Sheet3
Sheet1.Cells.Copy .[a1]
r = .Cells(Rows.Count, "B").End(3).Row
.Range(.[b8], .Cells(r, "J")).Sort key1:=.[b8].Offset(0, 8), order1:=1, Header:=xlNo
ar = .Range(.[b8], .Cells(r, "J"))
For i = 1 To UBound(ar)
If ar(i, 9) < 4000 Or ar(i, 9) > 8000 Then
If rngs Is Nothing Then
Set rngs = .Rows(i + 7)
Else
Set rngs = Union(rngs, .Rows(i + 7))
End If
End If
Next i
If Not rngs Is Nothing Then
rngs.Delete
End If
End With
End Sub

复制代码

效果如下图：

1121228509 · 发表于 2023-4-24 00:24

Sub 边压数据()
Dim Arr As Variant
Dim fk As Long, h As Long, L As Long, js As Long
fk = Sheets("表1").Cells(Rows.Count, 10).End(xlUp).Row - 7
Arr = Sheets("表1").Range("B8").Resize(fk, 9)
ReDim brr(1 To fk, 1 To 9) As Variant
For h = 1 To fk
If Arr(h, 9) > 3999.9 And Arr(h, 9) < 8000.1 Then '包括4000与8000
' If Arr(h, 9) > 4000 And Arr(h, 9) < 8000 Then '不包括4000与8000
      js = js + 1
      For L = 1 To 9
         brr(js, L) = Arr(h, L)
      Next L
End If
Next h
Sheets("表2").UsedRange.Offset(9).Delete Shift:=xlUp
Sheets("表2").UsedRange.Offset(7).ClearContents
Sheets("表2").Range("B9").Resize(js, 9).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove'设置与上方单元格格式相同
Sheets("表2").Range("B8").Resize(js, 9) = brr
Sheets("表2").Range("B7").Resize(fk, 9).Sort key1:=Sheets("表2").Range("J7"), order1:=xlAscending, Header:=xlYes'排序升序
End Sub

工作簿2.rar (26.99 KB, 下载次数: 2)

2217918 · 发表于 2023-4-26 22:54

本帖最后由 2217918 于 2023-4-26 22:58 编辑

不知道为什么发表于 2023-4-23 22:58
如图参考

老师，麻烦你在帮忙修改下：从表1中，根据表2中，G6单元格中的选择层数
选择三层，在表2中，就显示表1中，层数列，三层边压在1000-6000的数据
选择五层，在表2中，就显示表1中，层数列，五层边压在1000-6000的数据

小乔℡ · 发表于 2023-4-26 23:04

zxsea_7426 发表于 2023-4-23 23:19
复制全表，删除不符合要求的数据，并从大到小排序

！！！！！！！！！！！！！！！！！！牛

不知道为什么 · 发表于 2023-4-27 00:26

2217918 发表于 2023-4-26 22:54
老师，麻烦你在帮忙修改下：从表1中，根据表2中，G6单元格中的选择层数
选择三层，在表2中，就显示表1中 ...

如图，用了工作表事件，当G6单元格值变化时数据会自动刷新。

不知道为什么 · 发表于 2023-4-27 00:27

2217918 发表于 2023-4-26 22:54
老师，麻烦你在帮忙修改下：从表1中，根据表2中，G6单元格中的选择层数
选择三层，在表2中，就显示表1中 ...

附件测试。。。。。。。。。。

		自动登录	找回密码
密码			免费注册

[求助] 求助：从表1中，用vba筛选出边压在4000-8000的数据，表2中显示

评分

评分