Excel精英培训网

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

[已解决]这代码改改,谢谢!!1

[复制链接]
发表于 2012-11-24 18:35 | 显示全部楼层 |阅读模式
如果T2和u2以下,没数据,我点一下按钮,会增加新编号 排列  及两行空格,大家帮忙改一下代码,没数据时,不增加新编号 排列  及两行空格,并提示没增加数据,谢谢!!!
Sub Test555()
    Dim iRow, x, arr1(1 To 165536, 1 To 1), i, K
    iRow = Range("A:A").Find(what:="M30").Row
    x = Range("T:T").Find("", LookIn:=xlValues).Row - 1
    Arr = Range("T2:U" & x)
    For i = 1 To UBound(Arr)
        If i = 1 Then
            K = K + 1
            arr1(K, 1) = Arr(1, 1)
            K = K + 1
            arr1(K, 1) = Arr(1, 2)
        ElseIf Arr(i, 1) = Arr(i - 1, 1) Then
            K = K + 1
            arr1(K, 1) = Arr(i, 2)
        Else
            K = K + 1
            arr1(K, 1) = Arr(i, 1)
            K = K + 1
            arr1(K, 1) = Arr(i, 2)
        End If
    Next
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Range("A" & iRow).Resize(K).Insert Shift:=xlDown
    Range("A" & iRow).Resize(K) = arr1
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub
最佳答案
2012-11-24 20:44
    Range("A" & iRow).Resize(K + 2).Insert Shift:=xlDown
    Range("A" & iRow).Resize(K + 2) = arr1
改为
    Range("A" & iRow).Resize(K ).Insert Shift:=xlDown
    Range("A" & iRow).Resize(K) = arr1

Book10.rar

49.05 KB, 下载次数: 13

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-11-24 19:01 | 显示全部楼层
回复

使用道具 举报

发表于 2012-11-24 19:03 | 显示全部楼层
“如果T2和u2以下,没数据,我点一下按钮,会增加新编号 排列  及两行空格,大家帮忙改一下,没数据时,不增加新编号 排列  及两行空格,并提示没增加数据,谢谢!!!“

如果有数据,而且不止一行,那又如何。

有时贴需求,最好贴2张模拟的效果图,不然真看不出来,你想要达到的目的。

回复

使用道具 举报

 楼主| 发表于 2012-11-24 19:07 | 显示全部楼层
本帖最后由 fangniuji 于 2012-11-24 19:09 编辑
hwc2ycy 发表于 2012-11-24 19:03
“如果T2和u2以下,没数据,我点一下按钮,会增加新编号 排列  及两行空格,大家帮忙改一下,没数据时,不增 ...


如有数据,正常!!!添加数据!!把Y,Z列坐标贴在T2和U2,你帮忙看一下,谢谢!!!
回复

使用道具 举报

发表于 2012-11-24 19:15 | 显示全部楼层
  1. If Range("t" & Rows.Count).End(xlUp).Row = 1 And Range("u" & Rows.Count).End(xlUp).Row = 1 Then MsgBox "没有增加数据": Exit Sub
复制代码
判断是否有数据。
回复

使用道具 举报

 楼主| 发表于 2012-11-24 19:17 | 显示全部楼层
hwc2ycy 发表于 2012-11-24 19:15
判断是否有数据。

加在最后吗??帮我整理一下,谢谢!!!!
回复

使用道具 举报

发表于 2012-11-24 19:20 | 显示全部楼层
  1. Sub Test555()
  2.     Dim iRow, x, arr1(1 To 165536, 1 To 1), i, K
  3.     Dim TRow&, URow&
  4.     iRow = Range("A:A").Find(what:="M30").Row
  5.     x = Range("T:T").Find("", LookIn:=xlValues).Row - 1
  6.     TRow = Range("t" & Rows.Count).End(xlUp).Row
  7.     URow = Range("u" & Rows.Count).End(xlUp).Row
  8.     If TRow = 1 And URow = 1 Then MsgBox "没有增加数据": Exit Sub
  9.     x = IIf(TRow > URow, TRow, URow)
  10.     Arr = Range("T2:U" & x)
  11.     For i = 1 To UBound(Arr)
  12.         If i = 1 Then
  13.             K = K + 1
  14.             arr1(K, 1) = Arr(1, 1)
  15.             K = K + 1
  16.             arr1(K, 1) = Arr(1, 2)
  17.         ElseIf Arr(i, 1) = Arr(i - 1, 1) Then
  18.             K = K + 1
  19.             arr1(K, 1) = Arr(i, 2)
  20.         Else
  21.             K = K + 1
  22.             arr1(K, 1) = Arr(i, 1)
  23.             K = K + 1
  24.             arr1(K, 1) = Arr(i, 2)
  25.         End If
  26.     Next
  27.     Application.ScreenUpdating = False
  28.     Application.Calculation = xlManual
  29.     Range("A" & iRow).Resize(K + 2).Insert Shift:=xlDown
  30.     Range("A" & iRow).Resize(K + 2) = arr1
  31.     Application.ScreenUpdating = True
  32.     Application.Calculation = xlAutomatic
  33. End Sub
复制代码
回复

使用道具 举报

发表于 2012-11-24 19:21 | 显示全部楼层
不知道你是否要求在数据下面还要加两行空行。
现在是加了的。你看看。
回复

使用道具 举报

 楼主| 发表于 2012-11-24 19:23 | 显示全部楼层
本帖最后由 fangniuji 于 2012-11-24 19:24 编辑
hwc2ycy 发表于 2012-11-24 19:20


没数据时,不增加新编号 排列  及两行空格,再帮我一下,谢谢!!!
回复

使用道具 举报

发表于 2012-11-24 19:25 | 显示全部楼层
没数据时是没有增加嘛,你看看。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 15:28 , Processed in 0.535004 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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