[已解决]如何实现 LISTVIEW中查询结果导入其他sheet

wymhjj

请各位大虾们、朋友们帮忙解决一下 如何实现 LISTVIEW中查询结果导入其他sheet

详见附件：

最佳答案

月排行榜 / 总排行榜

那么的帅

2013-5-21 16:58

301256-VBA-控件-LISTVIEW数据导入工作表.rar (37.12 KB, 下载次数: 44)

2013-5-21 16:58 上传

点击文件名下载附件

跳转到最佳答案楼层

那么的帅

301256-VBA-控件-LISTVIEW数据导入工作表.rar (37.12 KB, 下载次数: 44)

2013-5-21 16:58 上传

点击文件名下载附件

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Integer
   
3.     Dim j As Integer
   
4.     Dim x As Integer
   
5.     Dim arr()
   
6.     Dim lCount As Long
   
7. 
   
8.     On Error GoTo ErrorHandler
   
9. 
   
10.     lCount = Me.ListView1.ListItems.Count
    
11.     If lCount = 0 Then
    
12.         MsgBox "列表中无数据可写入工作表"
    
13.         Exit Sub
    
14.     End If
    
15. 
    
16.     ReDim arr(0 To lCount, 1 To 7)
    
17.     For i = 1 To 7
    
18.         arr(0, i) = Sheet4.Cells(1, i)
    
19.     Next
    
20.     With Me.ListView1
    
21.         For i = 1 To lCount
    
22.             With .ListItems(i)
    
23.                 arr(i, 1) = .Text
    
24.                 For j = 2 To 7
    
25.                     arr(i, j) = .SubItems(j - 1)
    
26.                 Next j
    
27.             End With
    
28.         Next i
    
29.     End With
    
30.     With Sheet3
    
31.         Application.ScreenUpdating = False
    
32.         i = .Cells(Rows.Count, "b").End(xlUp).Row
    
33.         If i > 13 Then
    
34.             .Range("b13:h" & i).ClearContents
    
35.         End If
    
36.         .Range("b13").Resize(lCount + 1, 7).Value = arr
    
37.         Application.ScreenUpdating = True
    
38.     End With
    
39.     MsgBox "导出完成"
    
40.     Exit Sub
    
41. ErrorHandler:
    
42.     MsgBox Err.Number & vbCrLf & _
    
43.            Err.Description
    
44. 
    
45. End Sub

复制代码

wymhjj

太感谢了 ，你们都好银！！！！！！！！！！