[已解决]求助，请看这段代码

jiangslly

ReDim arr3(1 To UBound(arr), 1 To 19)
  With Sheet10
For i = 1 To r
MsgBox Sheet10.Cells(i, 14).Value
If Sheet10.Cells(i, 14).Value = "11" Then
m = m + 1
Sheets(Sheet16).Range("a&m:a&19") = Sheet10.Range("a&i:a&19")
End If
If Sheet10.Cells(i, 14).Value = "22" Then
n = n + 1
Sheets(Sheet17).Range("a&n:a&19") = Sheet10.Range("a&i:a&19")
End If
If Sheet10.Cells(i, 14).Value = "33" Then
l = l + 1
Sheet18.Range("a&l:s&l") = Sheet10.Range("a&i:s&i")
End If
Next
End With
这是我的一段代码，
我的想法是另一张工作表名等于sheet10中某一列中某个单元格的时候 ，把这一行所有的内容都输入到另一张工作表，主要是一行有几十列，我用上面的方面行不通
请问问题出在哪里？改怎么改啊

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-9 21:21

1. Sub 拆分工作表()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Dim sht As Worksheet, bm As String
   
5.     Dim arr1, arr2, arr3
   
6.     Dim d As New Dictionary
   
7.     Dim i As Long, j As Long, n As Long, m As Long
   
8.     Dim s As Long
   
9.     arr1 = Range("A1:N" & [B65536].End(xlUp).Row)
   
10.     arr2 = Application.Index(arr1, , 7)
    
11.     For i = 2 To UBound(arr2)
    
12.         d(arr2(i, 1)) = ""
    
13.     Next i
    
14.     For i = 0 To d.Count - 1
    
15.         m = 0
    
16.         bm = d.Keys(i)
    
17.         ReDim arr2(1 To UBound(arr1), 1 To 14)
    
18.         For n = 1 To UBound(arr1)
    
19.             If arr1(n, 7) = bm Or n = 1 Then
    
20.                 m = m + 1
    
21.                 arr3 = Application.Index(Application.Transpose(arr1), , n)
    
22.                 For j = 1 To 14
    
23.                     arr2(m, j) = arr3(j, 1)
    
24.                 Next j
    
25.             End If
    
26.         Next n
    
27.         s = 6
    
28.         For Each sht In Worksheets
    
29.             If sht.Name = bm Then
    
30.                 s = MsgBox("工作表已存在,是否删除", 4)
    
31.                 If s = 6 Then
    
32.                     Sheets(bm).Delete
    
33.                 End If
    
34.                 Exit For
    
35.             End If
    
36.         Next
    
37.         If s = 6 Then
    
38.             Set sht = Sheets.Add
    
39.             sht.Name = bm
    
40.             sht.Columns("B:B").NumberFormatLocal = "@"
    
41.             Sheets(bm).Range("A1").Resize(UBound(arr1), 14) = arr2   'Application.Transpose(Application.Transpose(arr2))
    
42.         Else
    
43.             s = Sheets(bm).Range("B65536").End(xlUp).Row + 1
    
44.             Sheets(bm).Range("A" & s).Resize(UBound(arr1), 14) = arr2
    
45.             Sheets(bm).Rows(s & ":" & s).Delete
    
46.         End If
    
47.     Next i
    
48.     Application.DisplayAlerts = True
    
49.     Application.ScreenUpdating = True
    
50. End Sub

复制代码

附件： 拆分-sunjing.rar (1.53 MB, 下载次数: 13)

2012-1-9 21:23 上传

点击文件名下载附件

跳转到最佳答案楼层

wayy

附件传上来看一下，只看代码解决不了实际问题。

sunjing-zxl

同意楼上，要附件才好测试

zjdh

要求十分简单，出现的问题情况不见描述，没有完整的语句和实际的附件无法分析问题。

jiangslly

sunjing-zxl 发表于 2012-1-9 20:14
同意楼上，要附件才好测试

附件在这里，谢谢

sunjing-zxl

jiangslly 发表于 2012-1-9 20:23
附件在这里，谢谢

你的Sheet10工作表何在？

jiangslly

sunjing-zxl 发表于 2012-1-9 21:05
你的Sheet10工作表何在？

我是重新换了个表，所以sheet10改成sheet1

sunjing-zxl

1. Sub 拆分工作表()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Dim sht As Worksheet, bm As String
   
5.     Dim arr1, arr2, arr3
   
6.     Dim d As New Dictionary
   
7.     Dim i As Long, j As Long, n As Long, m As Long
   
8.     Dim s As Long
   
9.     arr1 = Range("A1:N" & [B65536].End(xlUp).Row)
   
10.     arr2 = Application.Index(arr1, , 7)
    
11.     For i = 2 To UBound(arr2)
    
12.         d(arr2(i, 1)) = ""
    
13.     Next i
    
14.     For i = 0 To d.Count - 1
    
15.         m = 0
    
16.         bm = d.Keys(i)
    
17.         ReDim arr2(1 To UBound(arr1), 1 To 14)
    
18.         For n = 1 To UBound(arr1)
    
19.             If arr1(n, 7) = bm Or n = 1 Then
    
20.                 m = m + 1
    
21.                 arr3 = Application.Index(Application.Transpose(arr1), , n)
    
22.                 For j = 1 To 14
    
23.                     arr2(m, j) = arr3(j, 1)
    
24.                 Next j
    
25.             End If
    
26.         Next n
    
27.         s = 6
    
28.         For Each sht In Worksheets
    
29.             If sht.Name = bm Then
    
30.                 s = MsgBox("工作表已存在,是否删除", 4)
    
31.                 If s = 6 Then
    
32.                     Sheets(bm).Delete
    
33.                 End If
    
34.                 Exit For
    
35.             End If
    
36.         Next
    
37.         If s = 6 Then
    
38.             Set sht = Sheets.Add
    
39.             sht.Name = bm
    
40.             sht.Columns("B:B").NumberFormatLocal = "@"
    
41.             Sheets(bm).Range("A1").Resize(UBound(arr1), 14) = arr2   'Application.Transpose(Application.Transpose(arr2))
    
42.         Else
    
43.             s = Sheets(bm).Range("B65536").End(xlUp).Row + 1
    
44.             Sheets(bm).Range("A" & s).Resize(UBound(arr1), 14) = arr2
    
45.             Sheets(bm).Rows(s & ":" & s).Delete
    
46.         End If
    
47.     Next i
    
48.     Application.DisplayAlerts = True
    
49.     Application.ScreenUpdating = True
    
50. End Sub

复制代码

附件： 拆分-sunjing.rar (1.53 MB, 下载次数: 13)

2012-1-9 21:23 上传

点击文件名下载附件

FF7

Sheets(Sheet16).Range("a&m:a&19")
错误太多了
首先，工作表的表示方法有三中：sheet1，sheets(1)，sheets("sheet1")，如果用工作表名称引用工作表时，必须添加引号。所以上面的代码应该是sheets("sheet16")。
Range("a&m:a&19")这个写法完全是错误的。这里的a和m哪个是变量，哪个是表示列标？
Range("A" & m & ":A19") 是这么个意思么？？变量和字符串之间连接的话，要用引号区分开。变量不准夹在引号内！

jiangslly

FF7 发表于 2012-1-9 21:35
Sheets(Sheet16).Range("a&m:a&19")
错误太多了
首先，工作表的表示方法有三中：sheet1，sheets(1)，shee ...

谢谢，谢谢你了，学会如何表示工作表呢