用于连接名字的Excel宏有时会失败

时间:2015-12-18 17:26:36

标签: excel excel-vba vba

我是一名Visual Basic新手。从Web上的提示中,我拼凑了一个Excel宏,它可以执行多项操作,包括在循环中连接名字和姓氏,以创建一个包含连接的新列。有一半的时间它工作得很好,有一半的时间我最终在名字和姓氏之间没有空格。 (在这种情况下,关闭,重新打开和重新运行几乎总是有效。)这是一个时间问题吗?我会放入整个宏,但是我认为这是问题的顶部附近的Do While循环。

感谢您的帮助。

Sub WholeThing()
'
' WholeThing Macro
    Application.ScreenUpdating = False
    ActiveSheet.Name = "original"
    Rows("1:1").Delete Shift:=xlUp
    Do While ActiveCell <> ""  'Loops until the active cell is blank.
      ActiveCell.Offset(0, 0).FormulaR1C1 = _
      ActiveCell.Offset(0, 1) & " " & ActiveCell.Offset(0, 2)
      ActiveCell.Offset(1, 0).Select
    Loop
    Application.Wait (Now + TimeValue("0:00:02"))
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Original").Activate
    ActiveWindow.WindowState = xlNormal
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet6").Range("A1")
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet6").Range("B1")
    Sheets("Original").Activate
    ActiveWindow.WindowState = xlNormal
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Columns("Y:Y").Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A1")
    Columns("Z:Z").Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet3").Range("A1")
    Columns("AA:AA").Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet4").Range("A1")
    Columns("AB:AB").Copy
    ActiveSheet.Paste Destination:=Worksheets("Sheet5").Range("A1")
    Application.DisplayAlerts = False
    Sheets("Sheet5").Activate
    ActiveWorkbook.SaveAs Filename:="Y:\Addrs_DL", FileFormat:=xlCSV, _
        CreateBackup:=False
    Sheets("Sheet4").Activate
    ActiveWorkbook.SaveAs Filename:="Y:\Addrs_D", FileFormat:=xlCSV, _
        CreateBackup:=False
    Sheets("Sheet3").Activate
    ActiveWorkbook.SaveAs Filename:="Y:\Addrs_SL", FileFormat:=xlCSV, _
        CreateBackup:=False
    Sheets("Sheet2").Activate
    ActiveWorkbook.SaveAs Filename:="Y:\Addrs_S", FileFormat:=xlCSV, _
        CreateBackup:=False
    Sheets("Sheet6").Activate
    ChDir "Y:\"
    Application.ScreenUpdating = True
    ActiveWorkbook.SaveAs Filename:="Y:\NAME-ADR.CSV", FileFormat:=xlCSV, _
    CreateBackup:=False
 '    Application.Quit
 '    Application.ActiveWindow.Close SaveChanges:=False
 '    ActiveWorkbook.Close SaveChanges:=False
End Sub

2 个答案:

答案 0 :(得分:4)

不使用ActiveCell并直接使用您的范围,您可以使代码更稳定,更可靠。

考虑这样的事情(参见关于范围和单元格引用的假设的注释)。

Dim ws as Worksheet
Set ws = ThisWorkbook.Sheets("original")

With ws

     Dim lRow as Long
     lRow = .Range("B" & .Rows.Count).End(xlup).Row 'assumes first name in column B

     'assumes concatenated name goes in column A, starting at row 1 (and the first and last name are in B and C, respectively
     .Range("A1:A" & lRow).FormulaR1C1 = "=RC[1] & "" "" & RC[2]"

     'if you want to copy as values you can use this
     .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value

End With

您也可以使用在代码中直接使用该对象的相同原则,如下所示:

'lRow would be the last row of data in the column (assumes same row for each column, based on dataset)
ws.Range("Y1:Y" & lRow).Copy Worksheets("Sheet2").Range("A1")

这样做可以节省大量处理时间,因为如果不强烈要求整个非常效率很低。

答案 1 :(得分:1)

为了进行连接,我首先使用它来获取最后一行的数字:

Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

这使得这个循环能够进行连接:

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("original")
With ws
    For i = 1 To LastRow
        Cells(i, 1) = Cells(i, 2) & " " & Cells(i, 3)
    Next i

然后,对于第二个块(“With ws”仍然有效):

Sheets("Original").Activate
    Range("Y1:Y" & LastRow).Copy Worksheets("Sheet2").Range("A1")