清理ExcelVBA

时间:2017-03-10 14:10:02

标签: excel vba

我是VBA for excel的新人,并要求你的专业知识。

我做了一个录音马可巫婆的作品总体上很好,问题是我知道它可以更短,看起来更好,并且可能更快跑。

我已经读过,应尽可能避免使用.Select,并且在录制宏时,它会自动执行此操作。

Sub Audit_chat()

Range("R13").Select
Selection.Copy
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[h]:mm:ss"
Columns("F:K").Select
Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Range("B:B,C:C,N:N,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("Agents").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
    Header:=xlYes
Columns("D:D").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Sheets("Counter").Select
Range("A1").Select

End Sub

这可以修复,还是我注定了#34;终身? :)

解释它的作用。

Range("R13").Select
    Selection.Copy 

'' Copy a blank cell

Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

'' Select Range F2:K2 all the way to the end of the columns    

Selection.NumberFormat = "[h]:mm:ss"

'' set the numbers to [h]:mm:ss

原因:我的文件格式错误,即使我更改了格式,它也不会更新,但我发现如果我将一个空白单元格作为特殊粘贴复制到&# 34;值"和"添加"它解决了这个问题。

   Columns("F:K").Select
    Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

'' In Colums F:K find and replace "No Value" (Text) to "0"

   Range("B:B,C:C,N:N,O:O").Select
    Range("O1").Activate
    Selection.Copy
    Sheets("Agents").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

'' Copy all data in B:B,C:C,N:N,O:O, and paste it in Sheet "Agents"

   ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlYes

'' Remove duplicates in all cells A:D and has a header

   Columns("D:D").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste

'' Copy the all the information from colum D and paste it in C

Sheets("Counter").Select
Range("A1").Select

'' Go to Sheet "Counter"

提前致谢。

最诚挚的问候, 彼得

3 个答案:

答案 0 :(得分:1)

像宏录制器一样编写代码将是一个难以维护的噩梦。

这是我尝试清理(远远不是完美)(未经测试);

Sub x()

    '///////////////////
    '// First Action //
    '/////////////////
    Range("R13").Select
    Selection.Copy
    Range("F2:K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[h]:mm:ss"

    '// Try //
    Sheets("MySheet").[F2:K2].Value = [R13].Value
    Sheets("MySheet").[F2:K2].NumberFormat = "[h]:mm:ss"

    '////////////////////
    '// Second Action //
    '//////////////////
    Columns("F:K").Select
    Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    '// Try //
    Sheets("MySheet").[F:K].Replace What:="No Value", Replacement:="0", LookAt:=xlPart

    '///////////////////
    '// Third Action //
    '/////////////////

    Range("B:B,C:C,N:N,O:O").Select
    Range("O1").Activate
    Selection.Copy
    Sheets("Agents").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlYes

    '// Try //
    Sheets("MySheet").Range("B:B,C:C,N:N,O:O").Copy Sheets("Agents").[A1]
    Sheets("Agents").[A:D].RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

    '////////////////////
    '// Fourth Action //
    '////////////////////

    Columns("D:D").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Counter").Select
    Range("A1").Select ' I think this only exists to go back to where you started

    '// Try //
    Sheets("Mysheet").[D:D].Copy [C:C]

    '////////////////////////
    '// So, total code is //
    '//////////////////////

    Sheets("MySheet").[F2:K2].Value = [R13].Value
    Sheets("MySheet").[F2:K2].NumberFormat = "[h]:mm:ss"

    Sheets("MySheet").[F:K].Replace What:="No Value", Replacement:="0", LookAt:=xlPart

    Sheets("MySheet").Range("B:B,C:C,N:N,O:O").Copy Sheets("Agents").[A1]
    Sheets("Agents").[A:D].RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

    Sheets("Mysheet").[D:D].Copy [C:C]
End Sub

如果你激活/选择一个单元/表来操纵它,你自己是一个伤害,你应该从不需要*

* =除非宏/代码要专门访问感兴趣的单元格/表格(如“转到代理商列表”按钮或其他内容)

答案 1 :(得分:0)

呼!这是一些丑陋的代码。录制宏时,结果不容易阅读。

你能告诉我你要做什么吗?这将有助于我清理你的代码。

“。激活”vs.“。选择”

以下是外行人对“激活”和“选择”之间区别的解释:

使用“.Select”,例如工作表,您可以选择多个工作表。 “.Select”允许您一次对多个对象进行操作。

使用“.Activate”,例如工作表,只允许您一次激活一个工作表。因此,在下面的代码中,您将选择三个已选中但只激活一个的工作表。

Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Sheet2").Activate

在下面的代码中,您只能选择一个工作表。

Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Sheet2").Select

“。选择”可能会让您遇到麻烦的原因是,如果选择多个对象,您将对所选的所有对象进行操作。你可能想要也可能不想要那样。使用“.Activate”将您的操作限制为仅一个对象。

解决方案01

以下是解决方案的第一次尝试。一般情况下,我建议您使用VBA对象和Excel对象,并对代码进行评论。以下是如何做到这一点的一个选项。

代码更长,但在利用VBA / Excel对象库时更清晰,更容易理解。

我没有测试下面的代码。

Sub Audit_chat()

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    ' variables / object declaration
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' declare objects
    Dim wks_dest As Worksheet, wks_source As Worksheet
    Dim rng_srce_copy_01 As Range, rng_dest_01 As Range, rng_srce_copy_02 As Range
    Dim rng_dest_dup_01 As Range, rng_srce_copy_03 As Range

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    ' variables / object initialzation
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' set worksheet objects
    ' I don't know the name of the source worksheet
    Set wks_source = Worksheets("<Source Worksheet Name>")
    Set wks_dest = Worksheets("Agents")

    ' set source range objects
    Set rng_srce_copy_01 = wks_source.Range("R13")
    Set rng_srce_copy_02 = wks_source.Range("O1")
    Set rng_srce_copy_03 = wks_dest.Range("D:D")

    ' set desstination range objects
    Set rng_dest_01 = wks_source.Range("F:K")
    Set rng_dest_dup_01 = wks_dest.Range("$A$1:$D$1048575")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    ' start main method
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' copy the source 01
    rng_srce_copy_01.Copy

    ' paste information from range_srce_copy_01
    With rng_dest_01
        .PasteSpecial Paste:=xlPasteValues, _
                      Operation:=xlAdd, _
                      SkipBlanks:=False, _
                      Transpose:=False

        ' change cell format
        .NumberFormat = "[h]:mm:ss"

        ' replace "No Value" with 0
        .Replace What:="No Value", _
                 Replacement:="0", _
                 LookAt:=xlPart, _
                 SearchOrder:=xlByRows, _
                 MatchCase:=False, _
                 SearchFormat:=False, _
                 ReplaceFormat:=False
    End With

    ' application mode turn off
    Application.CutCopyMode = False

    ' copy source 02
    ' this will only copy one cell "O1" which is what your code is doing
    ' if you want to copy columns B, D, N, O then you need to define your
    ' range objct as:
    ' Set rng_srce_copy_02 = Range("B:B,C:C,N:N,O:O")
    ' this is where Select vs. Activate gets you in trouble
    ' do you want all the colums or just cell?
    rng_srce_copy_02.Copy

    ' go to destination worksheet
    ' you may have to break this up into:
    ' wks_dest.Activate
    ' Range("A1").Activate
    ' but I don't think so
    wks_dest.Range("A1").Activate
    wks_dest.Paste

    ' application mode turn off
    Application.CutCopyMode = False

    ' look at all the cells in the first two columns and remove
    ' the duplicates
    rng_dest_dup_01.RemoveDuplicates Columns:=Array(1, 2), _
                                     Header:=xlYes

    ' copy range 03
    rng_srce_copy_03.Copy

    ' paste at cell C1
    Range("C1").Select
    wks_dest.Paste

    ' go to "Counter" worksheet
    Worksheets("Counter").Activate
    Range("A1").Activate

End Sub

答案 2 :(得分:-1)

您可以尝试“加入”范围(“”)。选择下一行,例如

Range("R13").Select
Selection.Copy  

可以:

Range("R13").Copy

试试这个:

Sub Audit_chat()

Range("R13").Copy
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
    :=False, Transpose:=False
Selection.NumberFormat = "[h]:mm:ss"
Columns("F:K").Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Range("O1").Copy
Sheets("Agents").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
    Header:=xlYes
Columns("D:D").Copy
Range("C1").Select
ActiveSheet.Paste
Sheets("Counter").Range("A1").Select

End Sub