以列为条件从另一表中整行复制数据

sc204400 · 发表于 2022-11-25 10:15

本帖最后由 sc204400 于 2022-11-25 13:38 编辑

已实现从数据表Shee1中统计出库金额排名前20的物料到取样工作表中，现想以取样工作表中的B10：B29为条件，再从Sheet1表中B列物料名称相同的数据整行复制到Sheet3中，类同高级筛选，也可以直接在sheet1中直接将排名前20的明细数据一次性提取到sheet3中.

测试.rar (1.15 MB, 下载次数: 6)

LIUZHU · 发表于 2022-11-25 10:37

JSA代码

LIUZHU · 发表于 2022-11-25 10:38

WPS软件测试

sc204400 · 发表于 2022-11-25 10:50

没用WPS，想VBA解决

清风竹- · 发表于 2022-11-25 11:27

请看附件。

3190496160 · 发表于 2022-11-25 11:28

Sub shaixuan()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据源为空！": End
ar = .Range("a1:m" & r)
mc = Application.Large(.Range("l2:l" & r), 20)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
If Trim(ar(i, 12)) <> "" Then
      If IsNumeric(ar(i, 12)) Then
         If ar(i, 12) >= mc Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                  br(n, j) = ar(i, j)
            Next j
         End If
      End If
End If
Next i
With Sheets("sheet3")
.[a1].CurrentRegion.Offset(1).Borders.LineStyle = 0
.[a1].CurrentRegion.Offset(1) = Empty
.[a2].Resize(n, UBound(br, 2)) = br
.[a2].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2022-11-25 11:28

测试.rar (1.09 MB, 下载次数: 4)

sc204400 · 发表于 2022-11-25 13:39

3190496160 发表于 2022-11-25 11:28

测试了代码只取了一条记录，如果有多条记录也是需要取出来的

sc204400 · 发表于 2022-11-25 13:42

里面有多个月份同一物料名称相同的数据，只要物料号相同就从数据表中全部提取出来

sc204400 · 发表于 2022-11-25 15:06

清风竹- 发表于 2022-11-25 11:27
请看附件。

楼主代码完美，全部取出数据了

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

[求助] 以列为条件从另一表中整行复制数据

评分

评分

评分