[已解决]根据条件筛选复制不同表格

cyj153

根据条件筛选复制不同表格。谢谢1

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2021-11-28 13:26

1. Private Sub CommandButton1_Click()
   
2. Dim n&, i&, j&, arr, arrRst
   
3. arr = Sheets("2").[a1].CurrentRegion
   
4. ReDim arrRst(1 To UBound(arr), 1 To 12)
   
5. For i = 2 To UBound(arr)
   
6.   If ComboBox1 = arr(i, 4) Then
   
7.     n = n + 1
   
8.     arrRst(n, 1) = arr(i, 1)
   
9.     For j = 5 To 15
   
10.       arrRst(n, j - 3) = arr(i, j)
    
11.     Next j
    
12.   End If
    
13. Next i
    
14. Sheets(CStr(4 + (Val(ComboBox1) <= 10))).[a2].Resize(n, 12) = arrRst
    
15. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim n&, i&, j&, arr, arrRst
   
3. arr = Sheets("2").[a1].CurrentRegion
   
4. ReDim arrRst(1 To UBound(arr), 1 To 12)
   
5. For i = 2 To UBound(arr)
   
6.   If ComboBox1 = arr(i, 4) Then
   
7.     n = n + 1
   
8.     arrRst(n, 1) = arr(i, 1)
   
9.     For j = 5 To 15
   
10.       arrRst(n, j - 3) = arr(i, j)
    
11.     Next j
    
12.   End If
    
13. Next i
    
14. Sheets(CStr(4 + (Val(ComboBox1) <= 10))).[a2].Resize(n, 12) = arrRst
    
15. End Sub

复制代码

cyj153

大灰狼1976 发表于 2021-11-28 13:26

谢谢老师！

大灰狼1976

cyj153 发表于 2021-11-28 13:35
谢谢老师！

不必客气！

cyj153

大灰狼1976 发表于 2021-11-28 13:38
不必客气！

老师您好！再帮我看下，调整列后的生成。 根据条件筛选复制不同表格2.zip (39.3 KB, 下载次数: 14)

2021-11-28 15:12 上传

点击文件名下载附件

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim n&, i&, j&, arr, arrRst
   
3. arr = Sheets("2").[a1].CurrentRegion
   
4. ReDim arrRst(1 To UBound(arr), 1 To 12)
   
5. For i = 2 To UBound(arr)
   
6.   If ComboBox1 = arr(i, 4) Then
   
7.     n = n + 1
   
8.     For j = 7 To 15
   
9.       arrRst(n, j - 6) = arr(i, j)
   
10.     Next j
    
11.   End If
    
12. Next i
    
13. Sheets(CStr(4 + (Val(ComboBox1) <= 10))).[a2].Resize(n, 9) = arrRst
    
14. End Sub

复制代码

cyj153

大灰狼1976 发表于 2021-11-28 15:26

是这样谢谢老师！