时间戳

首页 > 解决方案 > Can you guys help me to make this code shorter? and smarter i guess

excel - Can you guys help me to make this code shorter? and smarter i guess

问题描述

Hi guys I'm a newbie on this so don't expect much from the code. Just tryna to make it shorter. Thanks! The code was made on the recorder macro function and I was cleaning it as much as I could. May be a smarter code for this but, basically is just to divide on 500 from the A column

Columns("A:A").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A501:A1000").Cut
    Range("B:B").Select
    ActiveSheet.Paste
Range("A1001:A1500").Cut
    Range("C:C").Select
    ActiveSheet.Paste
Range("A1501:A2000").Cut
    Range("D:D").Select
    ActiveSheet.Paste
Range("A2001:A2500").Cut
    Range("E:E").Select
    ActiveSheet.Paste
Range("A2501:A3000").Cut
    Range("F:F").Select
    ActiveSheet.Paste
Range("A3001:A3500").Cut
    Range("G:G").Select
    ActiveSheet.Paste
Range("A3501:A4000").Cut
    Range("H:H").Select
    ActiveSheet.Paste
Range("A4001:A4500").Cut
    Range("I:I").Select
    ActiveSheet.Paste
Range("A4501:A5000").Cut
    Range("J:J").Select
    ActiveSheet.Paste
End Sub```

标签： excelvba

解决方案

每当您发现自己重复代码时，您可能就错过了循环的机会。

lr代表最后使用的行 inColumn A
i代表当前行
c代表当前列

Sub Shorter_Better_Faster()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- UPDATE

Dim lr as Long, i As Long, c As Long

lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
c = 2

For i = 501 To lr Step 500
    ws.Range(ws.Cells(1, c), ws.Cells(500, c)).Value = ws.Range(ws.Cells(i, 1), ws.Cells(i + 500, 1)).Value
    c = c + 1
Next i

ws.Range("A501:A" & lr).ClearContents

End Sub

推荐阅读