求助如何批量移动单元格

Destinyclef

求助如何将  C1:D14、E1:F14、G1:H14以此类推的单元格批量的移动到A1:B14的下面，谢谢帮助。

moonlit123

1. Sub 移动()
   
2. Dim arr(), brr(), r, i, m
   
3. arr = Sheet1.[a1].CurrentRegion.Value
   
4. r = UBound(arr, 1) * UBound(arr, 2)
   
5. ReDim brr(1 To r, 1 To 2)
   
6. m = 0
   
7. For j = 1 To UBound(arr, 2) Step 2
   
8.    For i = 1 To UBound(arr, 1)
   
9.      m = m + 1
   
10.      brr(m, 1) = arr(i, j)
    
11.      brr(m, 2) = arr(i, j + 1)
    
12.    Next i
    
13. Next j
    
14. Sheet1.[a1].CurrentRegion.ClearFormats
    
15. Sheet1.[a1].CurrentRegion.ClearContents
    
16. Sheet1.[a1].Resize(UBound(brr, 1), UBound(brr, 2)).Value = brr
    
17. Sheet1.[a1].Resize(UBound(brr, 1), UBound(brr, 2)).Borders.LineStyle = 1
    
18. Erase arr
    
19. Erase brr
    
20. End Sub
    
21. 
    
22. 
    

复制代码

Destinyclef

moonlit123 发表于 2019-10-2 17:25

十分感谢大佬，帮了我大忙了。

Destinyclef

moonlit123 发表于 2019-10-2 17:25

大佬我在多问一下如果我想移动几个单元格，怎么调整公式，比如将D1:F20、G1:I20、移动到A1:C20的下面.

microyip

录制个宏就好了

moonlit123

Destinyclef 发表于 2019-10-5 10:44
大佬我在多问一下如果我想移动几个单元格，怎么调整公式，比如将D1:F20、G1:I20、移动到A1:C20的下面.

1. Sub 移动()
   
2. Dim arr(), brr(), r, i, m
   
3. arr = Sheet1.[a1].CurrentRegion.Value
   
4. r = UBound(arr, 1) * UBound(arr, 2)
   
5. ReDim brr(1 To r, 1 To 3)
   
6. m = 0
   
7. For j = 1 To 9 Step 3
   
8.    For i = 1 To UBound(arr, 1)
   
9.      m = m + 1
   
10.      brr(m, 1) = arr(i, j)
    
11.      brr(m, 2) = arr(i, j + 1)
    
12.      brr(m, 3) = arr(i, j + 2)
    
13.    Next i
    
14. Next j
    
15. Sheet1.[a1].CurrentRegion.ClearFormats
    
16. Sheet1.[a1].CurrentRegion.ClearContents
    
17. Sheet1.[a1].Resize(m, 3).Value = brr
    
18. Sheet1.[a1].Resize(m, 3).Borders.LineStyle = 1
    
19. Erase arr
    
20. Erase brr
    
21. End Sub

复制代码

Destinyclef

moonlit123 发表于 2019-10-5 12:17

多谢大佬!!!