0

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

我不是一个经验丰富的 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
4

1 回答 1

3

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

对于新的 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 相当于将光标放在“A”列的底行，然后单击 Ctrl+Up，它会跳转到“A”列的最后一行，并带有一个值。该行的编号放置在 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 的一个问题是，总是有几种方法可以达到相同的效果，而且通常没有明显的理由说明一种方法优于另一种方法。在我的代码版本中，我使用了插入列。我没有执行任何计时 - 所以我不知道哪种方法更快 - 我只是发现插入列更清晰。

我假设“Opret nye kolloner til at seperare tekst fra I2”说明了您为什么要这样做。请注意，我添加了 what和how。当我在 6 个月或 12 个月后回到这个代码时，我不想通过研究代码来发现什么、为什么或如何。我想被告知。据说 Unix 操作系统有很好的文档记录，但并非总是如此。显然，一段代码的标题是：“曾经只有上帝和我知道这个程序的作用。现在只有上帝知道。” 您不想对自己的代码这么说。我喜欢在写完自己的代码后一两个星期再看一遍，而我仍然或多或少记得它的作用。如果我难以理解，我知道它需要更多评论。

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 列重复此操作。

正如我之前所说，我假设 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

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

于 2012-11-22T23:46:51.053 回答