Question

Function copyHeader(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Cells(1, 1).Value = 4  'probably better to make this dynamic
End Function

Function copyDetail(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Cells(1, 1).Value = 4  'probably better to make this dynamic
End Function

Function createTab(tabname As String)
    Worksheets.Add.Name = tabname
End Function

Function shtExists(shtname As String) As Boolean
    Dim sht As Worksheet
    On Error GoTo ErrHandler:
    Set sht = Sheets(shtname)
    shtExists = True
ErrHandler:
    If Err.Number = 9 Then
        shtExists = False
    End If
End Function

Public Function lastCell(Col As String)
    With ActiveSheet
        lastCell = .Cells(.Rows.Count, Col).End(xlUp).Row
    End With
End Function

Sub AddData()
    Dim teamname As String
    Dim countery As Integer
    Dim teamdata As String
    Dim matchcounter As String
    Dim resp As Boolean
    Dim maxCounter As Integer

    counter = 4
    maxCounter = lastCell("B")

    On Error GoTo eh
    For counter = 4 To maxCounter
        ThisWorkbook.Sheets("DataEntry").Select
        teamdata = "C" & counter & ":" & "N" & counter
        teamname = ThisWorkbook.Sheets("DataEntry").Range("B" & counter).Value

    resp = shtExists(teamname)

    If resp = False Then
        createTab (teamname)

        copyHeader "C1:M3", "DataEntry", "B1", teamname
        matchcounter = CStr(Sheets(teamname).Range("A1").Value)
        copyDetail teamdata, "DataEntry", "B" & matchcounter, teamname

    ElseIf resp = True Then
        copyDetail teamdata, "DataEntry", "B" & matchcounter, teamname
    End If
    Next counter

Worksheets("DataEntry").Activate
Done:
    Exit Sub
eh:
    MsgBox "The following error occurred: " & Err.Description & " " & Err.Number & " " & Err.Source
End Sub

所以，当我尝试按照你从标题中看到的那样运行时，我得到一个应用程序定义的或对象定义的错误：1004。我试图让它迭代通过单元格B4到B9以及每个单元格，如果有的话在它创建它的单元格中没有带有名称的工作表，并将数据输入页面（C1：M3）上的标题和从C到I的该行上的数据粘贴到新创建的工作表上。如果它确实存在，它会查看具有该名称的工作表的A1，并将数据粘贴到列B和A1指定的行中。它对每个细胞的B4：B9都这样做。任何帮助，将不胜感激。

Answer 1

Dim teamdata As String

stringcombine = "C" & countery & ":" & "M" & countery

teamdata = Range(stringcombine)

在这里，您要为一个字符串分配一个数组（11个条目），因此类型不匹配。

阅读完代码后，您打算做什么

teamdata = Range(stringcombine).Address

虽然没有必要为地址创建额外的变量teamdata，但您已经在stringcombine中使用了它。

Answer 2

查看copypaste函数，看起来inputRange参数应该具有类似“C3：M3”的字符串值。您将teamdata传递给copypaste作为输入范围参数，那么您是否期望teamdata具有类似“C3：M3”的值？如果是，那么你的行

teamdata = Range(stringcombine)

可能是

teamdata = stringcombine

当前行尝试做的是从单元格范围中取值并将它们分配给字符串变量 - 它不是设计用来做的。如果stringcombine像“M3”那样它可以正常工作。一个单元格值到一个字符串。

Answer 3

错误13通常意味着您尝试将值分配给无法接受该数据类型的变量，或者您尝试将错误的数据类型作为参数传递给子或功能。

如果我了解您的要求，则应该可以替换现有代码：

Sub AddData_ReWrite()
    Dim teamName        As String
    Dim i               As Integer
    Dim matchCounter    As String
    Dim dataEntry       As Excel.Worksheet

    matchCounter = Range("A1").Value
    Set dataEntry = Sheets("DataEntry")

    For i = 4 To 9
        teamName = Sheets("DataEntry").Range("B" & i).Value
        CreateSheetIfNotExists teamName
        Sheets(teamName).Range("B" & matchCounter & ":N" & matchCounter).Value = dataEntry.Range("C" & i & ":M" & i).Value
    Next

    dataEntry.Activate

End Sub

Sub CreateSheetIfNotExists(ByVal sheetName As String)
    Dim sht As Worksheet

    On Error GoTo ErrHandler:

        Set sht = Sheets(sheetName)

ErrHandler:
    If (Err.Number) Then
        If Err.Number = 9 Then
            With Worksheets.Add
                .Name = sheetName
                .Range("B1:N3").Value = Sheets("DataEntry").Range("C1:M3").Value
                .Range("A1").Value = 2
            End With
        Else
            '// What if it isn't error 9?
            MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Error"
        End If
    End If

    '// clear errors and reset error handler
    Err.Clear
    On Error GoTo 0
End Sub

我已经整理了一下以提高可读性并在您的其他子例程中添加了额外的错误处理。

发生以下错误：应用程序定义或对象定义的错误1004 VBAProject

3 个答案: