Question

这是我的第一个问题，请耐心等待：）

我不是一位经验丰富的VBA程序员，我在自己的软件中遇到了一些问题。

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

该程序第一次完美，但第二次看起来它是错误地粘贴数据。它具有不同的外观，当程序从某些显然不存在的单元格中挑选数据时程序失败。

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

希望你有一些好主意。我试图清除所有格式，内容等。

谢谢。

这是我的代码，非常抱歉糟糕的编程风格。我需要将一些循环收集到更平滑的东西，但首先我需要它才能工作：）

感谢您的时间！

   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

Answer 1

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

新VBA程序员的一个简单错误就是编写一个在活动工作表上运行的宏。这样做很有效，直到你在调用宏之前查看另一张表。

例如，您可以写：

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

以上陈述适用于有效工作表。

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

在第二个例子中，我已经明确写过我希望我的语句可以在工作表Master上运行。请注意，我在Range之前和Cells之前添加了一个点。写得这样，启动宏时，您正在查看哪张表无关紧要。

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

看看你的代码。它做了什么假设？如果这没有帮助，请按照Kevin的要求发布您的代码。要做到这一点：

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

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

我一直在处理你的一些代码。我无法正常运行，因为我没有上下文;我不知道它在运行什么类型的数据。

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

在调试过程中，您不需要这些命令。

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

无论你想做什么，我都不相信这是实现它的好方法。我不得不删除它，所以我可以得到我可以运行的语句。编辑完成了一些代码并了解了它后，我想知道这是否是导致问题的原因。我稍后会谈到允许更好地理解你在做什么的代码。

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

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

'On Error GoTo myError:

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

Dim laps As Long

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

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

我假设上面的内容是试图确定早期粘贴加载的行数。麻烦的是这是计算空行数。你绝对确定空行是不可能的吗？我还假设10,000代表的行数超过了粘贴可能加载的行数。

有多种技术可以找到底行;这些都不适用于所有情况。最简单的技术是：

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

Rows.Count是您的Excel版本的最大行数。这个VBA相当于将光标放在列＃34; A＆＃34;的最下面一行。然后单击Ctrl + Up，跳转到列＃34; A＆＃34;中的最后一行。有价值的。该行的编号放在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.我被告知执行插入从左到右比从右到左执行它们要快一点，但我不在乎。如果一个例程每天要进行数千次，或者它确实很慢，那么我会考虑效率。但是如果所有保存的代码都是几毫秒的话，我就不会编写我觉得难以理解的代码。

VBA的一个问题是总有几种方法可以达到相同的效果，而且往往没有明显的理由说明为什么一种方法比另一种方法更好。在我的代码版本中，我使用了插入列。我没有执行任何计时 - 所以我不知道哪种方法（如果有的话）更快 - 我只是发现插入列更清晰。

我假设＆＃34; Opret nye kolloner直到在I2和＃34的seperare tekst？说为什么你这样做。请注意，我添加了内容和如何。当我在六到十二个月内回到这段代码时，我不想研究代码来发现什么，为什么或如何;我想被告知。据说Unix操作系统记录精美，但并非总是如此。显然是一段代码：＃34;只有上帝和我知道这个例程的作用。现在只有上帝才知道。＆＃34;您不想对自己的代码说出来。我喜欢在写完之后一两周看一下我自己的代码，而我仍然或多或少地记得它的作用。如果我很难理解，我知道它需要更多的评论。

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列。每个单元格包含＆＃34; Value1，Value2＆＃34;。您正在拆分这些值，因此＆＃34;值1和＃34;保留在A列，而＆＃34; Value2＆＃34;转到新清空的B列。对于C，E和G列重复这一过程。

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

您调用此宏btni2_Click()。我的猜测是用户选择一个感兴趣的范围并点击按钮 i2 。您的代码将该范围粘贴到工作表系统中，然后使用它进行播放。但这依赖于工作表 System 为空。如果新范围的行数少于最后一个范围，则您的代码将在新范围和一些较旧范围内运行。

考虑以下代码：

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开始的矩形。

我现在推荐使用此代码替代您的代码。注：（1）没有选择; （2）目标范围在开头有一个点，表示它由With语句限定; （3）我构建范围，允许我将它们包含在循环中。我没有将参数更改为TestToColumns，因为我对拆分的数据一无所知。

  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

我不会再看你的代码了。我给了你很多想法，我可能已经发现了你的问题的原因。如有必要，请回来提出更多问题。

Vba计划不会第二次运行

1 个答案: