[已解决]请高手帮忙看下怎么改，多谢了。

hwc2ycy

1. Dim filename As Variant
   
2. Sub Make_Config()
   
3.     Application.ScreenUpdating = False    '关闭屏幕更新
   
4.     filename = Application.GetOpenFilename("All Supported Files(*.xls),*.xls", Title:="请选择文件", MultiSelect:=False)
   
5.     If filename = False Then Exit Sub
   
6.     Call cpu
   
7. End Sub
   
8. Sub cpu()
   
9.     Dim wb, i, arr, brr, l
   
10.     arr = Sheets(1).Range("A4:K1000")
    
11.     Set wb = GetObject(filename)
    
12.     With wb.Sheets(1)
    
13.         brr = .Range(.Range("a2"), .Range("a2").End(xlToRight).End(xlDown))
    
14.     End With
    
15.     wb.Close False
    
16.     Dim arrPos
    
17.     arrPos = Array(0, 1, 2, 3, 8, 7, 9, 10, 11, 16)
    
18.     For i = 1 To UBound(arr)
    
19.         If (0 < brr(i, 4) And brr(i, 4) < 30000) And (0 < brr(i, 8) And brr(i, 8) < 30000) And (0 < brr(i, 11)) Then
    
20. 
    
21.             l = l + 1
    
22.             For j = 1 To UBound(arrPos)
    
23.                 arr(l, j) = brr(i, arrPos(j))
    
24.             Next
    
25.         End If
    
26.     Next i
    
27.     ThisWorkbook.Sheets(1).Range("A4").Resize(i - 1, UBound(arr, 2)) = arr
    
28. End Sub
    
29. 
    
30. Sub 清空()
    
31.     Sheets("Sheet1").Range("A4:k" & Sheets("Sheet1").Rows.Count).ClearContents
    
32. End Sub

复制代码

nysong10086

多谢了多谢了