[已解决]提取窗体数据

c888

提取成绩.zip (45.47 KB, 下载次数: 46)

2013-6-24 22:58 上传

点击文件名下载附件
请问老师：如何根据窗体中的年级与项目条件，将ListView1中前8名的数据提取到表2的表中。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-24 23:20

1. Private Sub CommandButton1_Click()
   
2.     Dim arr(1 To 8, 1 To 8)
   
3.     Dim i As Long, j As Long
   
4.     Dim lRecord As Long
   
5. 
   
6.     With Me.ListView1
   
7.         'ReDim arr(1 To 8, 1 To 8)
   
8.         For i = 1 To .ListItems.Count
   
9.             With .ListItems(i)
   
10.                 lRecord = Val(.SubItems(8))
    
11.                 If lRecord > 0 And lRecord <= 8 Then
    
12.                     For j = 4 To 11
    
13.                         arr(lRecord, j - 3) = .SubItems(j)
    
14.                     Next
    
15.                 End If
    
16.             End With
    
17.         Next
    
18.     End With
    
19.     With Sheet2
    
20.         .Range("p66").Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
21.     End With
    
22.     MsgBox "写入完成"
    
23. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

是名次列1-8，而非记录1-8？

小妖@GJT

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr(1 To 8, 1 To 8)
   
3.     Dim i As Long, j As Long
   
4.     Dim lRecord As Long
   
5. 
   
6.     With Me.ListView1
   
7.         'ReDim arr(1 To 8, 1 To 8)
   
8.         For i = 1 To .ListItems.Count
   
9.             With .ListItems(i)
   
10.                 If Val(.SubItems(8)) > 0 And Val(.SubItems(8)) <= 8 Then
    
11.                     lRecord = Val(.SubItems(8))
    
12.                     arr(lRecord, 1) = .Text
    
13.                     For j = 4 To 11
    
14.                         arr(lRecord, j - 3) = .SubItems(j)
    
15.                     Next
    
16.                 End If
    
17.             End With
    
18.         Next
    
19.     End With
    
20.     With Sheet2
    
21.         .Range("p66").Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
22.     End With
    
23.     MsgBox "写入完成"
    
24. End Sub

复制代码

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr(1 To 8, 1 To 8)
   
3.     Dim i As Long, j As Long
   
4.     Dim lRecord As Long
   
5. 
   
6.     With Me.ListView1
   
7.         'ReDim arr(1 To 8, 1 To 8)
   
8.         For i = 1 To .ListItems.Count
   
9.             With .ListItems(i)
   
10.                 lRecord = Val(.SubItems(8))
    
11.                 If lRecord > 0 And lRecord <= 8 Then
    
12.                     For j = 4 To 11
    
13.                         arr(lRecord, j - 3) = .SubItems(j)
    
14.                     Next
    
15.                 End If
    
16.             End With
    
17.         Next
    
18.     End With
    
19.     With Sheet2
    
20.         .Range("p66").Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
21.     End With
    
22.     MsgBox "写入完成"
    
23. End Sub

复制代码

slying1112

表示不懂