Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2820|回复: 6

[已解决]vba问题求助啊,真的很急

[复制链接]
发表于 2014-1-2 22:28 | 显示全部楼层 |阅读模式
Sub aaa()
Dim A1 As Worksheet, A2 As Worksheet, p As Integer, ts As Integer, I As Integer, j As Integer
ts = 1
Set A1 = Workbooks("RE_A1.xls").Worksheets("Sheet1")
Set A2 = Workbooks("TRD_Dalyr.xls").Worksheets("Sheet1")
Workbooks("TRD_Dalyr.xls").Worksheets("Sheet2").Select
m = A1.UsedRange.Rows.Count
n = A2.UsedRange.Rows.Count
For I = 2 To m
If Year(A1.Cells(I, 2)) = 2001 Then
   For j = 2 To n
     If A1.Cells(I, 1) = A2.Cells(j, 1) And A1.Cells(I, 2) = A2.Cells(j, 2) Then
      For p = -3 To 2
      Cells(ts + 4 + p, 1) = A2.Cells(j + p, 1)
      Cells(ts + 4 + p, 2) = A2.Cells(j + p, 2)
      Cells(ts + 4 + p, 3) = A2.Cells(j + p, 3)
      Cells(ts + 4 + p, 4) = A1.Cells(I, 3)
      Next p
      ts = ts + 6
     End If
    Next j
   End If
  Next I
End Sub

显示 n = A2.UsedRange.Rows.Count 对象变量或with块变量未设置
最佳答案
2014-1-3 08:22
  1. Sub aaa()
  2.     Dim A1 As Worksheet, A2 As Worksheet, p As Integer, ts As Integer, I As Integer, j As Integer
  3.     Dim m As Integer, n As Integer
  4.     ts = 1
  5.     On Error Resume Next
  6.     If Workbooks("RE_A1.xls") Is Nothing Then MsgBox "RE_A1.xls未打开": Exit Sub
  7.     Set A1 = Workbooks("RE_A1.xls").Worksheets("Sheet1")
  8.     If A1 Is Nothing Then MsgBox "RE_A1.xls中没有Sheet1工作表": Exit Sub
  9.     If Workbooks("TRD_Dalyr.xls") Is Nothing Then MsgBox "TRD_Dalyr.xls": Exit Sub
  10.     Set A2 = Workbooks("TRD_Dalyr.xls").Worksheets("Sheet1")
  11.     If A2 Is Nothing Then MsgBox "TRD_Dalyr.xls中无Sheet1工作表"
  12.     Workbooks("TRD_Dalyr.xls").Worksheets("Sheet2").Select
  13.     m = A1.UsedRange.Rows.Count
  14.     n = A2.UsedRange.Rows.Count
  15.     For I = 2 To m
  16.         If Year(A1.Cells(I, 2)) = 2001 Then
  17.             For j = 2 To n
  18.                 If A1.Cells(I, 1) = A2.Cells(j, 1) And A1.Cells(I, 2) = A2.Cells(j, 2) Then
  19.                     For p = -3 To 2
  20.                         Cells(ts + 4 + p, 1) = A2.Cells(j + p, 1)
  21.                         Cells(ts + 4 + p, 2) = A2.Cells(j + p, 2)
  22.                         Cells(ts + 4 + p, 3) = A2.Cells(j + p, 3)
  23.                         Cells(ts + 4 + p, 4) = A1.Cells(I, 3)
  24.                     Next p
  25.                     ts = ts + 6
  26.                 End If
  27.             Next j
  28.         End If
  29.     Next I
  30. End Sub
复制代码
发表于 2014-1-2 22:37 | 显示全部楼层
A2有符值引用没?
看看本地窗口。
另外,尽量不要用单元格的地址名做命名变量。
回复

使用道具 举报

 楼主| 发表于 2014-1-2 22:56 | 显示全部楼层
本帖最后由 pt2014pt 于 2014-1-2 23:03 编辑
hwc2ycy 发表于 2014-1-2 22:37
A2有符值引用没?
看看本地窗口。
另外,尽量不要用单元格的地址名做命名变量。

怎么看A2有符值引用?我是小白,临时有需要才改了这段代码,但运行的时候显示错误9,下标越界。
我想问下,因为我是想把表RE_A1.xls和TRD_Dalyr.xls中相应的数据筛选出来,然后填在TRD_Dalyr的sheet2中。但运行的时候,m能看到数字,但n显示对象变量或with块变量未设置。到底是哪里出错了?
回复

使用道具 举报

发表于 2014-1-3 08:22 | 显示全部楼层    本楼为最佳答案   
  1. Sub aaa()
  2.     Dim A1 As Worksheet, A2 As Worksheet, p As Integer, ts As Integer, I As Integer, j As Integer
  3.     Dim m As Integer, n As Integer
  4.     ts = 1
  5.     On Error Resume Next
  6.     If Workbooks("RE_A1.xls") Is Nothing Then MsgBox "RE_A1.xls未打开": Exit Sub
  7.     Set A1 = Workbooks("RE_A1.xls").Worksheets("Sheet1")
  8.     If A1 Is Nothing Then MsgBox "RE_A1.xls中没有Sheet1工作表": Exit Sub
  9.     If Workbooks("TRD_Dalyr.xls") Is Nothing Then MsgBox "TRD_Dalyr.xls": Exit Sub
  10.     Set A2 = Workbooks("TRD_Dalyr.xls").Worksheets("Sheet1")
  11.     If A2 Is Nothing Then MsgBox "TRD_Dalyr.xls中无Sheet1工作表"
  12.     Workbooks("TRD_Dalyr.xls").Worksheets("Sheet2").Select
  13.     m = A1.UsedRange.Rows.Count
  14.     n = A2.UsedRange.Rows.Count
  15.     For I = 2 To m
  16.         If Year(A1.Cells(I, 2)) = 2001 Then
  17.             For j = 2 To n
  18.                 If A1.Cells(I, 1) = A2.Cells(j, 1) And A1.Cells(I, 2) = A2.Cells(j, 2) Then
  19.                     For p = -3 To 2
  20.                         Cells(ts + 4 + p, 1) = A2.Cells(j + p, 1)
  21.                         Cells(ts + 4 + p, 2) = A2.Cells(j + p, 2)
  22.                         Cells(ts + 4 + p, 3) = A2.Cells(j + p, 3)
  23.                         Cells(ts + 4 + p, 4) = A1.Cells(I, 3)
  24.                     Next p
  25.                     ts = ts + 6
  26.                 End If
  27.             Next j
  28.         End If
  29.     Next I
  30. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-1-3 10:01 | 显示全部楼层
本帖最后由 pt2014pt 于 2014-1-3 13:22 编辑

已解决,感谢版主的回复。
回复

使用道具 举报

发表于 2014-1-4 11:08 | 显示全部楼层
hwc2ycy 发表于 2014-1-3 08:22

学习了
回复

使用道具 举报

发表于 2014-1-4 11:36 | 显示全部楼层
pt2014pt 发表于 2014-1-3 10:01
已解决,感谢版主的回复。

既然解决了,就设置个最佳答案吧。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 12:44 , Processed in 1.282411 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表