如何实现列的“跑马灯式”换位置

cjb3030

如图，请师傅们出手相助。先谢谢了哈！

山菊花

供参考。

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, t, tm, ii
  arr = [c1].CurrentRegion
  For ii = 1 To UBound(arr, 2) - 1
    For i = 1 To UBound(arr, 1)
      t = arr(i, 1)
      For j = 1 To UBound(arr, 2) - 1
        arr(i, j) = arr(i, j + 1)
      Next
      arr(i, j) = t
    Next
    [q1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    tm = Timer
    Do
      DoEvents
    Loop Until Timer - tm >= 0.5
  Next
End Sub

cjb3030

两位老师真是默契，一位点击一位自动全程，都很好！完美解决了我的问题。谢谢谢谢！祝您们新年健康快乐！一切如意！

qinglove1234

这个试试，自动的

cjb3030

qinglove1234 发表于 2020-2-1 12:49
这个试试，自动的

也行，但有点慢。

cjb3030

一把小刀闯天下 发表于 2020-2-1 09:24
Option Explicit

Sub test()

小刀师傅，你的代码速度很快。再请教个问题。如果只对C10：M27区域的列换位（其他的不动），并且在指定区域（C10：M27）里进行，换一次位运行另外的一个宏（如macro1）直至走马灯换一遍为止。该如何修改？能否实现？  师傅若有时间请多费心。谢谢哈！
Sub test()
  Dim arr, i, j, t, ii
  arr = [c1].CurrentRegion
  For ii = 1 To UBound(arr, 2) - 1
    For i = 1 To UBound(arr, 1)
      t = arr(i, 1)
      For j = 1 To UBound(arr, 2) - 1
        arr(i, j) = arr(i, j + 1)
      Next
      arr(i, j) = t
    Next
    [c1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
   Next
End Sub

一把小刀闯天下

'还带刹车的呢，是不是觉得很好玩，，，

Option Explicit

Sub test()
  Dim arr, i, j, t, tm, ii
  arr = [C10:M27].Value
  For ii = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr, 1)
      t = arr(i, 1)
      For j = 1 To UBound(arr, 2) - 1
        arr(i, j) = arr(i, j + 1)
      Next
      arr(i, j) = t
    Next
    [c10].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    tm = Timer
    Do
      DoEvents
    Loop Until Timer - tm >= 0.1 * Sqr(ii)
    Debug.Print "call macro1" & ii '可以调用不同过程
  Next
End Sub

cjb3030

一把小刀闯天下 发表于 2020-2-1 18:19
'还带刹车的呢，是不是觉得很好玩，，，

Option Explicit

嗯嗯。哈哈。谢谢！辛苦了。新年好啊！！！

yubo541

山菊花 发表于 2020-2-1 09:24
供参考。

你好老师，请问如果列是动态的如何实现。