VBA程序不会第二次运行 [英] Vba program wont run second time

问题描述

这是我的第一个问题，请耐心等待:)

This is my first question, so please be patient:)

我不是经验丰富的VBA程序员，并且我在软件中遇到了一些问题.

I am not an experienced VBA programmer, and I have made my self some issues in my software.

我有一个程序，可以在其中粘贴一些数据，然后添加一些新列.之后，它将拆分一些文本，并将其放在新列的单元格内.

I have a program wich pastes some data in and then adds some new columns. Afterwards it splits up some text and puts it inside the cells within the new columns.

该程序第一次运行完美，但是第二次看起来好像是错误地粘贴了数据.它具有不同的外观，并且当它从显然不存在的某些单元中选取数据时，程序会失败.

The program works perfect the first time, but second time it looks like it is pasting the data in wrong. It has a different look, and the program fails when it is picking data from some cells witch apparently doesnt exist.

它给我一个错误:无法获得工作表函数类的平均属性

It gives me a error of: unable to get the average property of the worksheet function class

希望您确实有一些好主意.我试图清除所有格式，内容等.

Hope you do have some good ideas. I have tried to clear all formats, content etc.

谢谢.

这是我的代码，对不起，不好的编程风格.我需要将一些循环收集到更平滑的内容中，但首先我需要它工作:)

Here is my code, very sorry for bad programming style. I need to collect some of my loops in to something smoother, but first i need it to work:)

谢谢您的时间！

   Option Explicit

Private Sub btnExit_Click()

Application.Quit


End Sub


Private Sub btni2_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Worksheets("System").Activate
Worksheets("System").Cells(1, 1).Select
ActiveCell.PasteSpecial

On Error GoTo myError:

Worksheets("System").Cells(2, 2) = "=COUNTA(A3:A10000)"
Dim laps As Integer
laps = Worksheets("System").Cells(2, 2)
'MsgBox ("Resultat er: " & laps)

' Opret nye kolloner til at seperare tekst fra I2.
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


'Flyt text til nye kolloner for at splitte data op
'Split A
    Range("A3:A10000").Select
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split C
    Range("C3:C10000").Select
    Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split E
    Range("E3:E10000").Select
    Selection.TextToColumns Destination:=Range("E3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split G
    Range("G3:G10000").Select
    Selection.TextToColumns Destination:=Range("G3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True


'check om der er data i Main arket
    Dim Check As String


    Check = Worksheets("Main").Range("B1").Value

    If Check = "" Then

        Worksheets("System").Range("A3").Copy
        Worksheets("Main").Select
        Range("B1").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("B3").Copy
        Worksheets("Main").Select
        Range("B2").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("C3").Copy
        Worksheets("Main").Select
        Range("B6").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("D3").Copy
        Worksheets("Main").Select
        Range("B4").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("E3").Copy
        Worksheets("Main").Select
        Range("B3").Select
        Selection.PasteSpecial
        Range("B7").Value = "Mads S. Christiansen"
        Worksheets("System").Select


    End If


    'definer alle de variabler der skal pastes ind i de respektive sessions
    Dim EditLaps As Integer
    Dim FastLap As Variant 'J
    Dim NoLaps As Integer 'inkl in/out brug variabel laps fra tidligere
    Dim TotalTime As Variant 'Sum af alle felter i J =sum(J3:J+laps)
    Dim TotalKm As Variant ' AM3 og AN & laps +3 trukket fra hinanden
    Dim MaxRpm As Long 'Max V3 til V & laps + 3
    Dim MaxWaterT As Double ' max O3 til O & laps + 3
    Dim AvgWaterT As Double ' avg O3 til O & laps + 3
    Dim MaxOilT As Double ' MAX Q3 til Q & laps + 3
    Dim AvgOilT As Double ' AVG
    Dim IntakeT As Double
    Dim MaxOilP As Double
    Dim MinOilP As Double
    Dim AvgOilP As Double
    Dim MaxCoolP As Double
    Dim MinCoolP As Double
    Dim AvgCoolP As Double
    Dim TotalKm1, TotalKm2 As Variant

    NoLaps = laps
    'Bruges som reference for at det passser med offset pga af første celle ref
    EditLaps = NoLaps + 2
    'Find hurtigste omgang og tildel den til FastLap
    FastLap = Application.WorksheetFunction.Min(Range(Cells(3, 10), Cells(EditLaps, 10)))
    ' Denne format virker !! Range("Z1").NumberFormat = "mm:ss.000"

    ' Total tid for session
    TotalTime = Format(Application.WorksheetFunction.Sum(Range(Cells(3, 10), Cells(EditLaps, 10))), "HH:MM:SS")

    'Total antal km for session, er dist slut minus dist start
    TotalKm1 = Range("AM3").Value
    TotalKm2 = Range("AN" & EditLaps).Value

    TotalKm = TotalKm2 - TotalKm1

    '------------------------------------------ Dette er for at convertere felte om til nummerisk formatering----------
    Dim a As Variant
    Dim b As Variant
    Dim c As Variant
    Dim d As Variant
    Dim e As Variant
    Dim f As Variant
    Dim g As Variant
    Dim h As Variant
    Dim i As Variant
    Dim j As Variant

    For Each a In Range("V1:V" & EditLaps)
    If a = "" Then GoTo nexta
    If IsNumeric(a) Then
        a.Value = a.Value * 1
        a.NumberFormat = "general"
    End If

nexta:
Next a

 For Each b In Range("N1:N" & EditLaps)
    If b = "" Then GoTo nextb
    If IsNumeric(b) Then
        b.Value = b.Value * 1
        b.NumberFormat = "general"
    End If

nextb:
Next b

For Each c In Range("O1:O" & EditLaps)
    If c = "" Then GoTo nextc
    If IsNumeric(c) Then
        c.Value = c.Value * 1
        c.NumberFormat = "general"
    End If

nextc:
Next c

For Each d In Range("K1:K" & EditLaps)
    If d = "" Then GoTo nextd
    If IsNumeric(d) Then
        d.Value = d.Value * 1
        d.NumberFormat = "general"
    End If

nextd:
Next d

For Each e In Range("L1:L" & EditLaps)
    If e = "" Then GoTo nexte
    If IsNumeric(e) Then
        e.Value = e.Value * 1
        e.NumberFormat = "general"
    End If

nexte:
Next e

For Each f In Range("Q1:Q" & EditLaps)
    If f = "" Then GoTo nextf
    If IsNumeric(f) Then
        f.Value = (f.Value * 1) / 1000
        f.NumberFormat = "general"
    End If

nextf:
Next f

For Each g In Range("P1:P" & EditLaps)
    If g = "" Then GoTo nextg
    If IsNumeric(g) Then
        g.Value = (g.Value * 1) / 1000
        g.NumberFormat = "general"
    End If

nextg:
Next g

For Each h In Range("R1:R" & EditLaps)
    If h = "" Then GoTo nexth
    If IsNumeric(h) Then
        h.Value = (h.Value * 1) / 1000
        h.NumberFormat = "general"
    End If

nexth:
Next h

For Each i In Range("T1:T" & EditLaps)
    If i = "" Then GoTo nexti
    If IsNumeric(i) Then
        i.Value = i.Value * 1
        If i.Value >= 1 Then
        i.Value = i.Value / 1000
        End If
        i.NumberFormat = "general"
    End If

nexti:
Next i

For Each j In Range("S1:S" & EditLaps)
    If j = "" Then GoTo nextj
    If IsNumeric(j) Then
        j.Value = j.Value * 1
        If j.Value >= 1 Then
        j.Value = j.Value / 1000
        End If
        j.NumberFormat = "general"
    End If

nextj:
Next j

    'Max rpm
    MaxRpm = Application.WorksheetFunction.Max(Range(Cells(3, "V"), Cells(EditLaps, "V")))

    'Max vand temp
    MaxWaterT = Application.WorksheetFunction.Max(Range(Cells(3, "N"), Cells(EditLaps, "N")))
    AvgWaterT = Application.WorksheetFunction.Average(Range(Cells(3, "O"), Cells(EditLaps, "O")))

    MaxOilT = Application.WorksheetFunction.Max(Range(Cells(3, "K"), Cells(EditLaps, "K")))
    AvgOilT = Application.WorksheetFunction.Average(Range(Cells(3, "L"), Cells(EditLaps, "L")))

    'IntakeT =

    MaxOilP = Application.WorksheetFunction.Max(Range(Cells(4, "Q"), Cells(EditLaps - 1, "Q")))
    MinOilP = Application.WorksheetFunction.Min(Range(Cells(4, "P"), Cells(EditLaps - 1, "P")))
    AvgOilP = Application.WorksheetFunction.Average(Range(Cells(4, "R"), Cells(EditLaps - 1, "R")))

    MaxCoolP = Application.WorksheetFunction.Max(Range(Cells(4, "T"), Cells(EditLaps - 1, "T")))
    MinCoolP = Application.WorksheetFunction.Min(Range(Cells(4, "S"), Cells(EditLaps - 1, "S")))
    AvgCoolP = Application.WorksheetFunction.Average(Range(Cells(4, "T"), Cells(EditLaps - 1, "T")))



    ' lav et object der indeholder det sheet som der skal bruges
    Dim Sheet As Object
    Set Sheet = Worksheets("Main")

    'Definer hvilken session der er kopieret ind
    Dim Session As String


    Session = UCase(Range("F3"))

    Select Case Session

    Case Is = " TEST"
        Set Sheet = Worksheets("Test")
    Case Is = " Q1"
        Set Sheet = Worksheets("Q1")
    Case Is = " Q2"
        Set Sheet = Worksheets("Q2")
    Case Is = " WU"
        Set Sheet = Worksheets("WU")
    Case Is = " RACE1"
        Set Sheet = Worksheets("Race1")
    Case Is = " RACE2"
        Set Sheet = Worksheets("Race2")
    End Select


    Sheet.Activate

    Range("B3").Value = FastLap
    Range("B4").Value = NoLaps
    Range("B5").Value = TotalTime
    Range("B7").Value = TotalKm
    Range("B13").Value = MaxRpm
    Range("B16").Value = MaxWaterT
    Range("B17").Value = AvgWaterT
    Range("B20").Value = MaxOilT
    Range("B21").Value = AvgOilT
    Range("B24").Value = 25
    Range("B27").Value = MaxOilP
    Range("B28").Value = MinOilP
    Range("B29").Value = AvgOilP
    Range("B32").Value = MaxCoolP
    Range("B33").Value = MinCoolP
    Range("B34").Value = AvgCoolP


    Sheet9.Activate
    Sheet9.Cells.Select
    With Cells
    .Clear
    .ClearComments
    .ClearContents
    .ClearFormats
    .ClearHyperlinks
    .ClearNotes
    .ClearOutline
    End With

    ' aktiver main siden efter endt handling af System seperation
    Worksheets("Main").Activate
    Cells(1, 1).Select
'Fjern hovedform fra billede og derefter vises Main arket.
MainForm.Hide


myError:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        If Err Then MsgBox Err.Description, vbCritical, "Error"


End Sub

Private Sub btnView_Click()
' aktiver kun main sheet hvis der oenskes view.
Worksheets("Main").Activate
'marker celle
Cells(1, 1).Select
'gem main form sΠder kun er normalt excel view
MainForm.Hide

End Sub

推荐答案

在代码添加到问题之前的答案

对于新的VBA程序员，一个简单的错误是编写一个在活动工作表上运行的宏.除非您在调用宏之前先查看另一张纸，否则效果会很好.

An easy mistake for the new VBA programmer is to write a macro that operates on the active worksheet. This works well until you look at another sheet before calling your macro.

例如，您可以写:

Range("A1").Value = "abc"
Cells(29, "B").Font.Bold = True

以上语句在活动工作表上运行.

The above statements operates on the active worksheet.

With Worksheets("Master")
  .Range("A1").Value = "abc"
  .Cells(29, "B").Font.Bold = True
End With

在第二个示例中，我已经明确地写了我要对语句进行操作的Master工作表.请注意，我在Range之前和Cells之前添加了一个点.这样写，启动宏时查看的是哪张纸都没有关系.

In this second example, I have explicitly written that I want to my statements to operate on worksheet Master. Note that I have added a dot before Range and before Cells. Written like this, it does not matter which sheet you were looking at when you started the macro.

不使用With语句指定目标工作表只是编写代码的一个示例，该代码仅在启动宏时光标位于正确的位置时才有效.您描述的症状与这种类型的错误相符.

Not using a With statement to specify the target worksheet is only one example of writing code that only works if the cursor is in the correct place when the macro is started. The symptoms you describe match this type of error.

查看您的代码.它有什么假设?如果这样做没有帮助，请按照Kevin的要求进行操作，然后发布您的代码.为此:

Look at your code. What assumptions does it make? If this does not help, do as Kevin asks and post your code. To do this:

• 编辑您的问题.
• 将您的代码复制到问题中.
• 选择代码，然后单击编辑窗口上方的大括号.这会在每行的开头添加四个空格，这会使它显示为代码.

在向问题添加代码后发布的答案

我一直在研究您的一些代码.我没有上下文，因此无法正常运行；我不知道它正在处理哪种数据.

I have been working through some of your code. I cannot run it properly because I have no context; I do not know what sort of data it is operating on.

但是，以下注释可能有用.当我发现要说的话时，我会添加更多内容.

However, the following comments may be useful. I will add more as I discover things to say.

在调试过程中，您都不希望使用这两个命令.

You do not want either of these commands during debugging.

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False

无论您想做什么，我都不认为这是实现目标的好方法.我不得不删除它，这样我才能得到可以运行的语句. 编辑处理了一些代码并获得了理解之后，我想知道这是否是导致您出现问题的原因.稍后，当我获得允许更好地了解您在做什么的代码时，我将对此进行讨论.

Whatever you are trying to do, I do not believe this is a good way of achieving it. I have had to delete it so I can get to statements I can run. Edit Having worked through some of your code and gained an understanding of it, I wonder if this is the cause of your problem. I discuss this later when I get to the code that allowed be to better understand what you are doing.

'Worksheets("System").Activate
'Worksheets("System").Cells(1, 1).Select
'ActiveCell.PasteSpecial

在将宏发布给其他人之前，我从未在自己的宏中包括错误处理.在测试期间，我希望宏停止在错误的语句上，并且不要因错误消息而优雅地失败，该错误消息的来源我不知道.

I never include error handling in my own macros until I want to release them to others. During testing, I want the macro to stop on the faulty statement and not to fail gracefully with an error message whose source I do not know.

'On Error GoTo myError:

我更喜欢将所有变量都放在宏的顶部，以便可以轻松找到它们.这不是必须的，只是我的偏爱.在32位系统上，Long是整数值的本机大小. Integer指定一个16位变量，并且需要特殊处理，这将导致执行速度变慢.

I prefer to group all my variables at the top of the macro so I can find them easily. This is not necessary, just my preference. On a 32-bit system, Long is the native size for an integer value. Integer specifies a 16-bit variable and requires special handling and will result in slower execution.

Dim laps As Long

我更改了以下内容，因此它使用With statement而不是切换工作表并选择单元格.切换和选择很慢，可能会造成混乱.除非必须，否则不要这样做.

I have changed the following so it uses a With statement rather than switch worksheets and select cells. Switching and selection is slow and can get very confusing. Don't do either unless you have to.

With Worksheets("System")
  .Cells(2, 2).Value = "=COUNTA(A3:A10000)"
  laps = .Cells(2, 2).Value
End With

我假设以上内容正在尝试确定早期粘贴所加载的行数.麻烦在于这是在计算空白行的数量.您完全确定空白行是不可能的吗?我还假设10,000代表的行数超过了粘贴所可能装载的行数.

I assume the above is trying to determine the number of lines loaded by the earlier paste. The trouble is this is counting the number of blank lines. Are you absolutely sure blank lines are impossible? I also assume that 10,000 represents the more rows than could possibly be loaded by the paste.

有多种技术可以找到最底行；在任何情况下都无法正常工作.最简单的技术是:

There are various techniques for finding the bottom row; none of which work in every situation. The easiest technique is:

Dim RowLast As Long
With Worksheets("System")
  RowLast = .Cells(Rows.Count, "A").End(XlUp).Row
End With

Rows.Count是您的Excel版本的最大行数.此VBA等效于将光标置于"A"列的底部行，然后单击Ctrl + Up，它会跳至带有值的"A"列的最后一行.该行的编号位于LastRow中.

Rows.Count is the maximum number of rows for your version of Excel. This VBA is the equivalent of placing the cursor in the bottom row of column "A" and then clicking Ctrl+Up which jumps to the last row in column "A" with a value. The number of that row is placed in LastRow.

考虑以下代码:

  Columns("B:B").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("D:D").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("F:F").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("H:H").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

以上代码的目的是在B，C，D和E列中的每一个之前创建一个空白列.但是，在B列之前插入一列会将C列移到D列.从左到右比从右到左执行它们的速度稍快，但是我不在乎.如果每天要执行数千次例程，或者例程确实很慢，那么我将考虑效率.但是，如果节省的时间只有几毫秒，我不会写很难理解的代码.

The objective of the above code is to create a blank column before each of columns B, C, D and E. However, inserting a column before column B move column C to column D. I am told that performing the insertions from left to right is slightly faster than performing them from right to left but I do not care. If a routine is to be performed thousands of time per day or if it really is slow then I will think about efficiency. But I will not write code I find difficult to understand if all it saves is a few milliseconds.

VBA的一个问题是，总是有几种方法可以达到相同的效果，并且通常没有明显的理由说明一种方法优于另一种方法.在您的代码版本中，我使用了插入列.我没有执行任何计时-所以我不知道哪种方法(如果有的话)更快-我只是发现插入列更清晰.

A problem with VBA is that there are always several method of achieving the same effect and often no obvious reason why one method is better than another. In my version of your code I have used insert column. I have not performed any timings - so I do not know which method, if either, is faster - I just find insert column clearer.

我假设在I2的Seperare tekst上的Opret nye kolloner til"说为什么.请注意，我已经添加了什么和如何.当我在六到十二个月内重新使用此代码时，我不想研究代码以发现什么，原因或方式.我想被告知.据说Unix操作系统已有精美的文档，但并非总是如此.显然有一段代码是这样的:只有我和上帝知道此例程的作用.现在只有上帝知道."您不想对自己的代码这么说.我喜欢在编写代码一周或两周后看一下自己的代码，虽然我仍然或多或少记得它的作用.如果我难以理解，我知道它需要更多评论.

I assume "Opret nye kolloner til at seperare tekst fra I2" says why you are doing this. Note that I have added what and how. When I come back to this code in six or twelve months I do not want to have to study the code to discover what, why or how; I want to be told. The Unix operating system is said to be beautifully documented but that it was not always so. Apparently a block of code was headed: "Once only God and I knew what this routine does. Now God alone knows." You do not want to have to say that about your own code. I like to look at my own code a week or two after I wrote it and while I still more-or-less remember what it does. If I struggle to understand, I know it needs more comments.

Dim ColCodeCrnt As Variant

With Worksheets("WRASystem")
  ' Insert a blank column before each of columns E, D, C and B.
  ' Insertions in reverse order to make code clearer since an
  ' insertion before column B moves column C.
  For Each ColCodeCrnt In Array("E", "D", "C", "B")
    .Columns(ColCodeCrnt).EntireColumn.Insert
  Next
End With

现在考虑以块开头:

  Range("A3:A10000").Select
  Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
      TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
      Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
      :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

由此我推断出，您粘贴在开始的块有N行和4列.每个单元格包含"Value1，Value2".您正在拆分这些值，以便值1"保留在A列中，而值2"保留到新清空的列B中.对C，E和G列重复此操作.

From this I deduce that the block you paste in at the beginning has N rows and 4 columns. Each cell contains "Value1,Value2". You are splitting the values so "Value 1" remains in column A while "Value2" goes to newly emptied column B. This is repeated for columns C, E and G.

正如我之前所说，我假设10000代表了一个不大的行号，它代表了块的大小.我已经在上面向您展示了如何获取工作表的实际最后一行.稍后，我将向您展示如何使用最后一行的编号来改进此代码.但是，我有一个问题需要首先解决.

As I said before, I assume 10000 represents an impossibly large row number for the size of the block. I have shown you above how to get the actual last row of a worksheet. In a moment, I will show you how to use the number of the last row to improve this code. However, I have a problem that needs to be addressed first.

您将此宏称为btni2_Click().我的猜测是用户选择了一个感兴趣的范围，然后单击按钮 i2 .您的代码会将范围粘贴到工作表 System 中，然后进行处理.但这依赖于工作表 System 为空.如果新范围的行少于上一个范围，则您的代码将在新范围和一些较旧的范围内运行.

You call this macro btni2_Click(). My guess is that the user selects a range of interest and clicks button i2. Your code pastes that range into worksheet System and then plays with it. But that relies on worksheet System being empty. If the new range has fewer rows that the last range, your code will operate on the new range and some of the older range.

考虑以下代码:

Sub btni2_Click()

  Dim AddrSrc As String
  Dim WkShtSrc As String

  WkShtSrc = Selection.Worksheet.Name
  AddrSrc = Selection.Address

  Debug.Print WkShtSrc & "!" & AddrSrc

  With Worksheets("System")
    .Cells.EntireRow.Delete
    Range(WkShtSrc & "!" & AddrSrc).Copy Destination:=.Range("A1")
  End With

此代码要做的第一件事是记录所选范围的详细信息.我包含了Debug.Print，因此您可以看到我保存的内容.然后，我可以做任何我想做的事情而不会丢失选择的细节.如果确实如此，我要做的就是删除工作表中的每一行(即清除它)，然后再将源范围复制到从单元格A1开始的矩形中.

The first thing this code does is record the details of the selected range. I have included a Debug.Print so you can see what I have saved. I can then do whatever I like without losing the details of the selection. If fact, all I do is delete every row in the worksheet (that is, clear it) before copying the source range to the rectangle starting at cell A1.

我现在建议将此代码替换为您的代码.注意:(1)没有选择； (2)目标范围的开头有一个圆点，以表明它已由With语句限定； (3)建立范围，使我可以将它们包括在循环中.我没有将参数更改为TestToColumns，因为我对拆分的数据一无所知.

I now recommend this code as a replacement for yours. Notes: (1) there is no selection; (2) the destination range has a dot at the beginning to indicate that it is qualified by the With statement; (3) I build the ranges which allows me to include them in a loop. I have not changed the parameters to TestToColumns because I do not know anything about the data being split.

  With Worksheets("WRASystem")
    For Each ColCodeCrnt In Array("A", "C", "E", "G")
      .Range(ColCodeCrnt & "3:" & ColCodeCrnt & RowLast).TextToColumns _
              Destination:=.Range(ColCodeCrnt & "3"), DataType:=xlDelimited, _
              TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
              Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
              FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
             TrailingMinusNumbers:=True
    Next
  End With

我将不再查看您的代码.我给了您很多思考的机会，而且我可能已经发现了造成问题的原因.如有必要，再问更多问题.

I will not look at any more of your code. I have given you much to think about and I might have discovered the cause of your problem. Come back with more questions if necessary.

这篇关于VBA程序不会第二次运行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！