提取到的数据如何进行修改并保存

无忧鸟

       在B2输入查找条件是可以提取到保存在F盘“资料”文件夹里的工作表数据的，现想添加个修改并保存
的代码，就是把提取到的数据根据需要进行修改单
元格数据或删除整行，然后原路保存到原来F盘路
径里的工作表格相对应的单元格里，望大师们能出
手相助，谢谢！ 提取数据后修改并保存.zip (32.29 KB, 下载次数: 35)

2020-1-8 17:51 上传

点击文件名下载附件

liulang0808

Sub dsmch()


Application.ScreenUpdating = False
Sheet2.Activate
Set sh = ActiveSheet
tj = [b2]
With Workbooks.Open("F:\资料\资料.xlsx")
    arr = .Sheets(1).UsedRange
   
    r = 2
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If arr(i, j) Like "*" & tj & "*" Then

                r = r + 1
                For X = 1 To UBound(arr, 2)
                    arr(i, X) = sh.Cells(r, X)
                Next X
                Exit For
            End If
        Next
    Next
     .Sheets(1).UsedRange = arr
    .Close False
End With
Application.ScreenUpdating = True
End Sub
代码没有测试，，，，

无忧鸟

liulang0808 发表于 2020-1-8 19:33
Sub dsmch()

试了好多遍都没反应，自已也尝试找了找原因但还是没能解决！

liulang0808

无忧鸟 发表于 2020-1-8 21:59
试了好多遍都没反应，自已也尝试找了找原因但还是没能解决！

1. Sub 按钮4_Click()
   
2. 
   
3. 
   
4. 
   
5. Application.ScreenUpdating = False
   
6. Sheet2.Activate
   
7. Set sh = ActiveSheet
   
8. tj = [b2]
   
9. With Workbooks.Open("F:\资料\资料.xlsx")
   
10.     arr = .Sheets(1).UsedRange
    
11.    
    
12.     r = 2
    
13.     For i = 1 To UBound(arr)
    
14.         For j = 1 To UBound(arr, 2)
    
15.             If arr(i, j) Like "*" & tj & "*" Then
    
16. 
    
17.                 r = r + 1
    
18.                 For X = 1 To UBound(arr, 2)
    
19.                     arr(i, X) = sh.Cells(r, X)
    
20.                 Next X
    
21.                 Exit For
    
22.             End If
    
23.         Next
    
24.     Next
    
25.      .Sheets(1).UsedRange = arr
    
26.      .Save
    
27.     .Close True
    
28. End With
    
29. Application.ScreenUpdating = True
    
30. 
    
31. End Sub

复制代码

代码执行完没有保存，这次看看吧

无忧鸟

liulang0808 发表于 2020-1-9 07:36
代码执行完没有保存，这次看看吧

终于可以运行了，非常非常感谢您的帮忙！