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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 移动位置问题
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 2785|回复: 15

[已解决]移动位置问题

[复制链接]
发表于 2012-11-28 22:20 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
帮忙一下，我想把A列%下T4一组坐标放在T1之前，T99一组坐标放在T01之后根据G2到I2设定参数，，H2前G2如有数据，I2后没有，就执行G2，总之G2后I2，有数据就执行，没数据就不执行。（一组是T* 上下相邻  ，如T1一组是与T1与T2之间 A列A9，A10。或T与M30 相邻为一组如T99一组是A22，A23（M30是结束意思）结果如B列，谢谢
最佳答案
月排行榜 / 总排行榜
hwc2ycy
2012-11-29 11:02
本帖最后由 hwc2ycy 于 2012-12-19 20:27 编辑
  1. Option Explicit
  2. Sub 移位3()
  3.     '2012-12-19 hwc2ycy 修改
  4.     Dim str1$, str2$, str3$
  5.     Dim pos1&, pos2&, pos3&
  6.     Dim i&, i3&
  7.         
  8.     str1 = UCase(Range("g2"))
  9.     str2 = UCase(Range("h2"))
  10.     str3 = UCase(Range("i2"))
  11.     On Error Resume Next
  12.     ' 数据的局限性，必须以非数字开始，其后必须是数字
  13.     If Len(str2) = 0 Then MsgBox "H2单元格无数据": Exit Sub
  14.     If Len(str1) > 2 Then str1 = Left(str1, 1) & Right(str1, Len(str1) - 1) * 1
  15.     If Len(str2) > 2 Then str2 = Left(str2, 1) & Right(str2, Len(str2) - 1) * 1
  16.     If Len(str3) > 2 Then str3 = Left(str3, 1) & Right(str3, Len(str3) - 1) * 1

  18.    
  19.     If Len(str1) > 0 Then
  20.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
  21.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub

  23.         pos1 = Range("a:a").Find(str1, , , xlWhole).Row
  24.         If Err.Number <> 0 Then MsgBox "G2数据无法找到": Exit Sub

  26.         i = pos1 + 1
  27.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
  28.             i = i + 1
  29.         Loop
  30.         
  31.         Application.ScreenUpdating = False
  32.         'G2置前
  33.         If pos2 <> i Then
  34.             Range("a" & pos1 & ":a" & i - 1).Cut
  35.             Range("a" & pos2).Insert xlShiftDown
  36.         End If
  37.         Application.ScreenUpdating = True
  38.     End If
  39.         
  40.     If Len(str3) > 0 Then
  41.         pos3 = Range("a:a").Find(str3, , , xlWhole).Row
  42.         If Err.Number <> 0 Then MsgBox "I2数据无法找到": Exit Sub
  43.         '取后置行
  44.         i = pos3 + 1
  45.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Cells(i, 1) Like "M30" Or Cells(i, 1) Like "%"
  46.             i = i + 1
  47.         Loop
  48.         i3 = i - 1
  49.         
  50.         '中间行
  51.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
  52.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub
  53.         i = pos2 + 1
  54.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
  55.             i = i + 1
  56.         Loop
  57.         
  58.         Application.ScreenUpdating = False
  59.         If i <> pos3 Then
  60.             Range("a" & pos3 & ":a" & i3).Cut
  61.             Range("a" & i).Insert xlShiftDown
  62.         End If
  63.         Application.ScreenUpdating = True
  64.     End If
  65. End Sub
复制代码

移动位置.rar

11.28 KB, 下载次数: 13
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2012-11-29 11:02 | 显示全部楼层    本楼为最佳答案   
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 hwc2ycy 于 2012-12-19 20:27 编辑
  1. Option Explicit
  2. Sub 移位3()
  3.     '2012-12-19 hwc2ycy 修改
  4.     Dim str1$, str2$, str3$
  5.     Dim pos1&, pos2&, pos3&
  6.     Dim i&, i3&
  7.         
  8.     str1 = UCase(Range("g2"))
  9.     str2 = UCase(Range("h2"))
  10.     str3 = UCase(Range("i2"))
  11.     On Error Resume Next
  12.     ' 数据的局限性，必须以非数字开始，其后必须是数字
  13.     If Len(str2) = 0 Then MsgBox "H2单元格无数据": Exit Sub
  14.     If Len(str1) > 2 Then str1 = Left(str1, 1) & Right(str1, Len(str1) - 1) * 1
  15.     If Len(str2) > 2 Then str2 = Left(str2, 1) & Right(str2, Len(str2) - 1) * 1
  16.     If Len(str3) > 2 Then str3 = Left(str3, 1) & Right(str3, Len(str3) - 1) * 1

  18.    
  19.     If Len(str1) > 0 Then
  20.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
  21.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub

  23.         pos1 = Range("a:a").Find(str1, , , xlWhole).Row
  24.         If Err.Number <> 0 Then MsgBox "G2数据无法找到": Exit Sub

  26.         i = pos1 + 1
  27.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
  28.             i = i + 1
  29.         Loop
  30.         
  31.         Application.ScreenUpdating = False
  32.         'G2置前
  33.         If pos2 <> i Then
  34.             Range("a" & pos1 & ":a" & i - 1).Cut
  35.             Range("a" & pos2).Insert xlShiftDown
  36.         End If
  37.         Application.ScreenUpdating = True
  38.     End If
  39.         
  40.     If Len(str3) > 0 Then
  41.         pos3 = Range("a:a").Find(str3, , , xlWhole).Row
  42.         If Err.Number <> 0 Then MsgBox "I2数据无法找到": Exit Sub
  43.         '取后置行
  44.         i = pos3 + 1
  45.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Cells(i, 1) Like "M30" Or Cells(i, 1) Like "%"
  46.             i = i + 1
  47.         Loop
  48.         i3 = i - 1
  49.         
  50.         '中间行
  51.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
  52.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub
  53.         i = pos2 + 1
  54.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
  55.             i = i + 1
  56.         Loop
  57.         
  58.         Application.ScreenUpdating = False
  59.         If i <> pos3 Then
  60.             Range("a" & pos3 & ":a" & i3).Cut
  61.             Range("a" & i).Insert xlShiftDown
  62.         End If
  63.         Application.ScreenUpdating = True
  64.     End If
  65. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-11-29 12:02 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
hwc2ycy 发表于 2012-11-29 11:02

谢谢你的帮忙，可能我表述有问题，G2有数据，就执行G2放前，I2有数据就执行I2，G2和I2同时有就同时执行，现在问题是G2和I2同时有才执行，谢谢你改一下，谢谢。
回复

使用道具 举报

hwc2ycy
发表于 2012-11-29 12:24 | 显示全部楼层
楼主，要么你自己改改，也练练。我看你也是08年注册的ID嘛。
回复

使用道具 举报

 楼主| 发表于 2012-11-29 12:43 | 显示全部楼层
hwc2ycy 发表于 2012-11-29 12:24
楼主，要么你自己改改，也练练。我看你也是08年注册的ID嘛。

再帮忙一下，制造业比较忙，现在比较闲，老板逼得搞资料，谢谢啦，平时很少上网，谢谢！！
回复

使用道具 举报

hwc2ycy
发表于 2012-11-29 14:18 | 显示全部楼层
本帖最后由 hwc2ycy 于 2012-11-29 15:13 编辑
  1. Option Explicit
  2. Sub 移位2()
  3.     Dim str1$, str2$, str3$
  4.     Dim pos1&, pos2&, pos3&
  5.     Dim i&, i3&
  6.         
  7.     str1 = Range("g2")
  8.     str2 = Range("h2")
  9.     str3 = Range("i2")
  10.     On Error Resume Next
  11.     If Len(str1) = 0 Then MsgBox "G2单元格无数据": Exit Sub
  12.     If Len(str2) > 2 Then str2 = Left(str2, 1) & Right(str2, Len(str2) - 1) * 1
  13.     ' 数据的局限性，必须以非数字开始
  14.     pos2 = Range("a:a").Find(str2, , , xlWhole).Row
  15.     If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub
  16.         
  17.     Application.ScreenUpdating = False
  18.     If Len(str1) > 0 Then
  19.         If Len(str1) > 2 Then str1 = Left(str1, 1) & Right(str1, Len(str1) - 1) * 1
  20.         pos1 = Range("a:a").Find(str1, , , xlWhole).Row
  21.         If Err.Number <> 0 Then MsgBox "G2数据无法找到": Exit Sub

  23.         i = pos1 + 1
  24.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%"
  25.             i = i + 1
  26.         Loop
  27.         'G2置前
  28.         Range("a" & pos1 & ":a" & i - 1).Cut
  29.         If pos2 <> i Then Range("a" & pos2).Insert xlShiftDown
  30.         Application.CutCopyMode = False
  31.     End If
  32.         
  33.     If Len(str3) > 0 Then
  34.         If Len(str3) > 2 Then str3 = Left(str3, 1) & Right(str3, Len(str3) - 1) * 1
  35.         pos3 = Range("a:a").Find(str3, , , xlWhole).Row
  36.         If Err.Number <> 0 Then MsgBox "I2数据无法找到": Exit Sub
  37.         '取后置行
  38.         i = pos3 + 1
  39.         
  40.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Cells(i, 1) Like "M30" Or Cells(i, 1) Like "%"
  41.             i = i + 1
  42.         Loop
  43.         i3 = i - 1
  44.         
  45.         '中间行
  46.         i = pos2 + 1
  47.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%"
  48.             i = i + 1
  49.         Loop
  50.                     
  51.         Range("a" & pos3 & ":a" & i3).Cut
  52.         If i <> pos3 Then Range("a" & i).Insert xlShiftDown
  53.         Application.CutCopyMode = False
  54.     End If
  55.     Application.ScreenUpdating = True
  56. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-11-29 14:37 | 显示全部楼层
hwc2ycy 发表于 2012-11-29 14:18

谢谢谢你的帮忙，谢谢！！！
回复

使用道具 举报

 楼主| 发表于 2012-11-29 20:01 | 显示全部楼层
hwc2ycy 发表于 2012-11-29 14:18

(M30是结束意思，M30位置不管他们怎么移动，一定要在数据最后面，这一点老师一定帮我考虑进去，得出数据才正确数据，我没表述清楚，抱歉！！！）谢谢！！
回复

使用道具 举报

 楼主| 发表于 2012-12-19 10:24 | 显示全部楼层
hwc2ycy 发表于 2012-11-29 14:18

我再用的时候发现问题如G2是T99时结果如B列，M30是结束意思，不能移动，这个帮我改一下，谢谢！！另I2（T3）前面有H2（T01）没G2（T99）时也可执行，谢谢这两个问题改一下，非常谢谢！！！

移动位置小问题.rar

20.31 KB, 下载次数: 4
回复

使用道具 举报

hwc2ycy
发表于 2012-12-19 11:02 | 显示全部楼层
fangniuji 发表于 2012-12-19 10:24
我再用的时候发现问题如G2是T99时结果如B列，M30是结束意思，不能移动，这个帮我改一下，谢谢！！另I2（ ...

晚上再帮你改哈。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-25 15:43 , Processed in 0.388130 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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