[已解决]VBA80集 第15集

h200797080

tmp3361.rar (4.2 KB, 下载次数: 8)

2012-6-12 17:32 上传

点击文件名下载附件 Sub 分类汇总()
Dim x As Integer, m1 As Integer, m2 As Integer
  Dim k As Integer
  m1 = 2
  For x = 2 To 1000
    If Cells(x, 1) = "" Then Exit Sub
    If Cells(x, 1) <> Cells(x + 1, 1) Then
      m2 = x
      Rows(x + 1).Insert
      Cells(x + 1, "a") = Cells(x, "a")
      Cells(x + 1, "f") = "=sum(f" & m1 & ":f" & m2 & ")"
      Cells(Sheets(1).Range("a1").End(xlDown).Row + 1, 1) = Sheets(2).Cells(x + 1, "a").Value
      Cells(Sheets(1).Range("b1").End(xlDown).Row + 1, 2) = Sheets(2).Cells(x + 1, "f").Value     
    '(我想把汇总的项目添加到一张新表中,于是新添了2行代码，调试没有错误，但是为什么sheet1中没有数据？？)
     x = x + 1
      m1 = m2 + 2
    End If
  Next x
End Sub

最佳答案

月排行榜 / 总排行榜

兰色幻想

2012-6-12 17:34

Cells(Sheets(4).Range("a1").End(xlDown).Row + 1, 1)  这样并不表示是sheet4中的数据 cells前面要加sheet4工作表才行

跳转到最佳答案楼层

兰色幻想

Cells(Sheets(4).Range("a1").End(xlDown).Row + 1, 1)  这样并不表示是sheet4中的数据 cells前面要加sheet4工作表才行

h200797080

兰色幻想 发表于 2012-6-12 17:34
Cells(Sheets(4).Range("a1").End(xlDown).Row + 1, 1)  这样并不表示是sheet4中的数据 cells前面要加sheet ...

Sheets(1).Cells(Sheets(1).Range("a1").End(xlDown).Row + 1, 1) = Sheets(2).Cells(x + 1, "a").Value
Sheets(1).Cells(Sheets(1).Range("b1").End(xlDown).Row + 1, 2) = Sheets(2).Cells(x + 1, "f").Value
修改了代码之后Sheet1中还是没有数据

兰色幻想

提问时要把附件传上来.VBA代码有时需要测试才能看出来.

h200797080

兰色幻想 发表于 2012-6-13 13:32
提问时要把附件传上来.VBA代码有时需要测试才能看出来.

呃 表已经上传了啊

h200797080

兰色幻想 发表于 2012-6-12 17:34
Cells(Sheets(4).Range("a1").End(xlDown).Row + 1, 1)  这样并不表示是sheet4中的数据 cells前面要加sheet ...

问题已经解决，除了sheet4还有XLDOWN的问题
不过这个xldown没有提示下标越界 提示的  是应用程序定义或对象定义错误
所以老没看懂 不知道这么回事？？