设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 如何让D1以下一个数据也可执行
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1996|回复: 7

[已解决]如何让D1以下一个数据也可执行

[复制链接]
发表于 2012-12-12 21:40 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
这个帮我改改为什么D2到D20只有一个数据时不运行这个宏，帮我改改只有一个数据时也执行，谢谢！！
最佳答案
月排行榜 / 总排行榜
hwc2ycy
2012-12-12 21:50
  1.             ARR2 = .Range("D2:D" & ROW1)
  2.             
  3.             ReDim arr11(1 To UBound(arr1) + UBound(ARR2), 1 To 1)
复制代码
如果ROW1等于2时，ARR2就是非数组了，接着就报错。

ii.rar

19.09 KB, 下载次数: 9
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2012-12-12 21:50 | 显示全部楼层    本楼为最佳答案   
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1.             ARR2 = .Range("D2:D" & ROW1)
  2.             
  3.             ReDim arr11(1 To UBound(arr1) + UBound(ARR2), 1 To 1)
复制代码
如果ROW1等于2时，ARR2就是非数组了，接着就报错。

评分

参与人数 1 +3 收起 理由
fangniuji + 3

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2012-12-12 22:00 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
hwc2ycy 发表于 2012-12-12 21:50
如果ROW1等于2时，ARR2就是非数组了，接着就报错。

帮我改一下，谢谢谢谢！！
回复

使用道具 举报

hwc2ycy
发表于 2012-12-12 22:23 | 显示全部楼层
，还没解决，就来最佳了啊。
回复

使用道具 举报

 楼主| 发表于 2012-12-12 22:24 | 显示全部楼层
hwc2ycy 发表于 2012-12-12 22:23
，还没解决，就来最佳了啊。

鼓励一下，辛苦啦！！！！
回复

使用道具 举报

hwc2ycy
发表于 2012-12-12 22:29 | 显示全部楼层
  1. Sub test1()
  2.     With Sheets("%")
  3.         row1 = .Range("D20").End(xlUp).Row
  4.         row2 = .Range("A65536").End(xlUp).Row
  5.         arr1 = .Range("A1:A" & row2)
  6.         If row1 > 1 Then
  7.             If row1 = 2 Then
  8.                 ReDim arr2(1 To 1, 1 To 1)
  9.                arr2(1, 1) = .Range("D2:D" & row1)
  10.             Else
  11.                 arr2 = .Range("d2:d" & row1)
  12.             End If
  13.             
  14.             ReDim arr11(1 To UBound(arr1) + UBound(arr2), 1 To 1)
  15.             For i = 1 To UBound(arr1)
  16.                 k = k + 1
  17.                 arr11(k, 1) = arr1(i, 1)
  18.                 If arr1(i, 1) = "%" Then
  19.                     For J = 1 To UBound(arr2)
  20.                         k = k + 1
  21.                         arr11(k, 1) = arr2(J, 1)
  22.                     Next J
  23.                 End If
  24.             Next i
  25.             '清空B列，结果显示在B列
  26.             .Columns("B:B").ClearContents
  27.             .Range("B1").Resize(k, 1) = arr11
  28.         Else
  29.             '清空B列，结果显示在B列
  30.             .Columns("B:B").ClearContents
  31.             .Range("B1").Resize(UBound(arr1), 1) = arr1
  32.         End If
  33.     End With
  34. End Sub

  36. Sub test2()
  37.     With Sheets("%")
  38.         row1 = .Range("D20").End(xlUp).Row
  39.         row2 = .Range("A65536").End(xlUp).Row
  40.         arr1 = .Range("A1:A" & row2)
  41.         If row1 > 1 Then
  42.             If row1 = 2 Then
  43.                 ReDim arr2(1 To 1, 1 To 1)
  44.                 arr2(1, 1) = .Range("d2:d" & row1)
  45.             Else
  46.                 arr2 = .Range("D2:D" & row1)
  47.             End If
  48.             ReDim arr11(1 To UBound(arr1) + UBound(arr2), 1 To 1)
  49.             For i = 1 To UBound(arr1)
  50.                
  51.                 If arr1(i, 1) = "%" Then
  52.                     For J = 1 To UBound(arr2)
  53.                         k = k + 1
  54.                         arr11(k, 1) = arr2(J, 1)
  55.                     Next J
  56.                 End If
  57.                 k = k + 1
  58.                 arr11(k, 1) = arr1(i, 1)
  59.             Next i
  60.             '清空B列，结果显示在B列
  61.             .Columns("B:B").ClearContents
  62.             .Range("B1").Resize(k, 1) = arr11
  63.         Else
  64.             '清空B列，结果显示在B列
  65.             .Columns("B:B").ClearContents
  66.             .Range("B1").Resize(UBound(arr1), 1) = arr1
  67.         End If
  68.     End With
  69. End Sub
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2012-12-12 22:33 | 显示全部楼层
  1. Sub test1()
  2.     Dim arr2
  3.     With Sheets("%")
  4.         row1 = .Range("D20").End(xlUp).Row
  5.         row2 = .Range("A65536").End(xlUp).Row
  6.         arr1 = .Range("A1:A" & row2)
  7.         If row1 > 1 Then
  8.             If row1 = 2 Then
  9.                 ReDim arr2(1 To 1, 1 To 1)
  10.                arr2(1, 1) = .Range("D2:D" & row1)
  11.             Else
  12.                 arr2 = .Range("d2:d" & row1)
  13.             End If
  14.             
  15.             ReDim arr11(1 To UBound(arr1) + UBound(arr2), 1 To 1)
  16.             For i = 1 To UBound(arr1)
  17.                 k = k + 1
  18.                 arr11(k, 1) = arr1(i, 1)
  19.                 If arr1(i, 1) = "%" Then
  20.                     For J = 1 To UBound(arr2)
  21.                         k = k + 1
  22.                         arr11(k, 1) = arr2(J, 1)
  23.                     Next J
  24.                 End If
  25.             Next i
  26.             '清空B列，结果显示在B列
  27.             .Columns("B:B").ClearContents
  28.             .Range("B1").Resize(k, 1) = arr11
  29.         Else
  30.             '清空B列，结果显示在B列
  31.             .Columns("B:B").ClearContents
  32.             .Range("B1").Resize(UBound(arr1), 1) = arr1
  33.         End If
  34.     End With
  35. End Sub

  37. Sub test2()
  38.     Dim arr2
  39.     With Sheets("%")
  40.         row1 = .Range("D20").End(xlUp).Row
  41.         row2 = .Range("A65536").End(xlUp).Row
  42.         arr1 = .Range("A1:A" & row2)
  43.         If row1 > 1 Then
  44.             If row1 = 2 Then
  45.                 ReDim arr2(1 To 1, 1 To 1)
  46.                 arr2(1, 1) = .Range("d2:d" & row1)
  47.             Else
  48.                 arr2 = .Range("D2:D" & row1)
  49.             End If
  50.             ReDim arr11(1 To UBound(arr1) + UBound(arr2), 1 To 1)
  51.             For i = 1 To UBound(arr1)
  52.                
  53.                 If arr1(i, 1) = "%" Then
  54.                     For J = 1 To UBound(arr2)
  55.                         k = k + 1
  56.                         arr11(k, 1) = arr2(J, 1)
  57.                     Next J
  58.                 End If
  59.                 k = k + 1
  60.                 arr11(k, 1) = arr1(i, 1)
  61.             Next i
  62.             '清空B列，结果显示在B列
  63.             .Columns("B:B").ClearContents
  64.             .Range("B1").Resize(k, 1) = arr11
  65.         Else
  66.             '清空B列，结果显示在B列
  67.             .Columns("B:B").ClearContents
  68.             .Range("B1").Resize(UBound(arr1), 1) = arr1
  69.         End If
  70.     End With
  71. End Sub
复制代码
上面的，对于2个的有问题，改了下。
回复

使用道具 举报

 楼主| 发表于 2012-12-12 22:41 | 显示全部楼层
hwc2ycy 发表于 2012-12-12 22:33
上面的，对于2个的有问题，改了下。

这个OK啦OK哦OKOK
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-26 01:55 , Processed in 1.706263 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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