如何使用VBA实现从工作表中提取符合关键字的数据行并按设定格式显示在另一工作表中

超越2018 · 发表于 2023-11-20 23:30

如何使用VBA实现从另一个文件夹中工作簿中提取符合关键字的数据行到本工作表中，并按设定格式显示在另一工作表中，具体要求在附件中，谢谢各位高手！

shiruiqiang · 发表于 2023-11-21 07:48

建议lz好好学习一下，慢慢表达一下

超越2018 · 发表于 2023-11-21 08:10

shiruiqiang 发表于 2023-11-21 07:48
建议lz好好学习一下，慢慢表达一下

非常抱歉，昨晚忙太晚写错了，“23年未入“应该是”23年进货明细“

超越2018 · 发表于 2023-11-21 08:15

shiruiqiang 发表于 2023-11-21 07:48
建议lz好好学习一下，慢慢表达一下

”入库“和”已入“两个工作表都在JXRK工作簿中，将”已入“表的数据转换到”入库“表中

超越2018 · 发表于 2023-11-21 08:17

本帖最后由超越2018 于 2023-11-21 08:25 编辑

各位高手，附件写的不明白，这里重新说一下：
1.将质检号码下面的质检号（2301169、2301170、2301172）在”2023年进货明细“中的数据行复制出来放到”已入“工作表中，”2023年进货明细“被复制的数据标上蓝色，方便区分。
2.”已入“工作表的数据信息再按新格式放到”入库“工作表中。

3190496160 · 发表于 2023-11-21 08:41

超越2018 发表于 2023-11-21 08:17
各位高手，附件写的不明白，这里重新说一下：
1.将质检号码下面的质检号（2301169、2301170、2301172）在 ...

2.”已入“工作表的数据信息再按新格式放到”入库“工作表中。
直接一步到位不行吗，为什么要多一个步骤呢？？？

chxw68 · 发表于 2023-11-21 08:46

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Dim rng As Range
Set d = CreateObject("scripting.dictionary")
With Worksheets("已入")
r = .Cells(.Rows.Count, 16).End(xlUp).Row
arr = .Range("p1:p" & r)
For i = 2 To UBound(arr)
d(arr(i, 1)) = Empty
Next
End With
If Dir(ThisWorkbook.Path & "\未入库文件", vbDirectory) = "" Then
MsgBox "未入库文件夹不存在！"
Exit Sub
End If
If Dir(ThisWorkbook.Path & "\未入库文件\进货明细.xlsx") = "" Then
MsgBox "进货明细.xlsx不存在！"
Exit Sub
End If
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\未入库文件\进货明细.xlsx")
With wb
With .Worksheets("23年进货明细")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:l" & r)
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
m = 0
For i = 1 To UBound(arr)
If d.exists(arr(i, 10)) Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
If rng Is Nothing Then
Set rng = .Cells(i + 1, 1).Resize(1, 12)
Else
Set rng = Union(rng, .Cells(i + 1, 1).Resize(1, 12))
End If
End If
Next
If Not rng Is Nothing Then
rng.Interior.ColorIndex = 23
End If
End With
.Close True
End With
If m = 0 Then
MsgBox "没有符合条件数据！"
Exit Sub
End If
With ThisWorkbook.Worksheets("已入")
.Range("a2:l" & .Rows.Count).Clear
With .Range("a2").Resize(m, UBound(brr, 2))
.Value = brr
.Borders.LineStyle = xlContinuous
With .Font
.Name = "宋体"
.Size = 10
End With
End With
End With
ReDim crr(1 To m, 1 To 10)
For i = 1 To m
crr(i, 1) = brr(i, 2)
crr(i, 3) = brr(i, 4)
crr(i, 4) = "Kg"
crr(i, 5) = brr(i, 6)
crr(i, 6) = brr(i, 8)
crr(i, 7) = brr(i, 9)
crr(i, 10) = brr(i, 10)
Next
With ThisWorkbook.Worksheets("入库")
.UsedRange.Offset(2, 0).Clear
With .Range("a3").Resize(m, UBound(crr, 2))
.Value = crr
.Borders.LineStyle = xlContinuous
With .Font
.Name = "宋体"
.Size = 10
End With
End With
End With
End Sub

复制代码

沈默00 · 发表于 2023-11-21 08:47

本帖最后由沈默00 于 2023-11-21 12:44 编辑

chxw68 · 发表于 2023-11-21 08:48

本帖最后由 chxw68 于 2023-11-21 10:34 编辑

参与一下。

沈默00 · 发表于 2023-11-21 08:49

本帖最后由沈默00 于 2023-11-21 12:45 编辑

试一下.....

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

[求助] 如何使用VBA实现从工作表中提取符合关键字的数据行并按设定格式显示在另一工作表中

评分