时间戳

首页 > 解决方案 > 收到运行时错误 13 将使用 instring 函数

excel - 收到运行时错误 13 将使用 instring 函数

问题描述

在此处输入图像描述当我第二次导入文件时，第一次的数据没有被删除。因此，一旦我导入第二个文件，第二个文件数据就会从第一个数据旁边的列开始。我在下面的代码，在导入部分之后我试图解决这个问题


Sub ImportCMOSLog(Path As String, filename As String)
    'Sheets.Add After:=Sheets(Sheets.Count)
    
 
    Sheets("Data").Select
    
    On Error Resume Next
    'ActiveSheet.Name = filename
    Range("A1").FormulaR1C1 = filename
    Range("A2").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Path & filename, Destination:=Range("$A$1"))
        .Name = filename                                                    'change activesheet to sheets("Data")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = " "
        .Refresh BackgroundQuery:=False
    End With
End Sub
Dim strSearch As String
    strSearch = "Time/min"
    
    Dim x As String
    Dim sheet As String
    Dim myrange As String
    sheet = "Data"
    myrange = "$A$1:$BC$1"
    Set x = Worksheets("Data").Range("$A$1:$BC$1") [object required error over here]
    
    
    
    For Each Cell In x
        If InStr(x.Value, strSearch) > 0 Then                 [runtime error received over here]
            lastrow = ActiveCell.SpecialCells(xlLastCell).Row
            Columns("B:B").Select
            Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("B1").Select
            ActiveCell.FormulaR1C1 = "Time/min"
            Range(Cells(2, 2), Cells(lastrow, 2)).Select
            Selection.FormulaR1C1 = "=(RC[-1]-R3C1)*24*60"
            Selection.NumberFormat = "General"
        Else
            Sheets("Data").Cells.Clear
        End If
    Next Cell

标签： excelvba

解决方案

我认为你让它变得复杂然后需要（我可能错了）但你实际上想要做的是

  1. 清除旧数据
  2. 插入标题为 的新数据Date，Y1并且Y2
  3. 在其中插入一列B
  4. 给它一个标题，Time/min以便新标题是Date,Time/min和Y1Y2
  5. 在列中插入公式B

如果我的理解是正确的，那么试试这个（未测试）。如果您有任何错误，请告诉我。

Option Explicit

Sub ImportCMOSLog(Path As String, filename As String)
    Dim ws As Worksheet
    Dim lRow As Long
    
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Data")
    
    With ws
        .Cells.Clear
        
        With .QueryTables.Add(Connection:= _
            "TEXT;" & Path & filename, Destination:=.Range("$A$1"))
            .Name = filename
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = False
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = xlWindows
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileOtherDelimiter = "|"
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = " "
            .Refresh BackgroundQuery:=False
        End With
        
        .Columns(2).Insert Shift:=xlToRight
        
        .Range("B1").Value = "Time/min"
        
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        .Range("B2:B" & lRow).FormulaR1C1 = "=(RC[-1]-R3C1)*24*60"
    End With
End Sub

推荐阅读