1

我有一段代码应该按名称检查工作表是否存在。如果工作表存在，则有一些复制和过去功能，如果工作表不存在，则它将创建并遵循相同的复制过去功能。我无法获得正确的布尔值以返回主子。布尔值始终注册为 false（我知道这是默认值）。我尝试了几种不同的方法来纠正这个问题，但我仍然遇到问题。我真的可以使用一些帮助，这可能是一个简单的修复。

Sub BreakOutCategories()

    Dim catSheet As Worksheet
    Dim catName As String
    Dim Range1 As Range
    Dim gRange As Range
    Dim toSheet As Worksheet
    Dim CheckSheet As Boolean
    Dim CreateSheet As Boolean
    Dim i As Long

        Set catSheet = Sheets("MasterList")
        Set Range1 = catSheet.Range("A1", catSheet.Range("A1").End(xlDown))

            For Each gRange In Range1

            i = 0
            catName = gRange.Value

            CheckMySheet (catName)

                If CheckSheet = True Then

                    toSheet = Sheets(gRange.Value)

                    gRange.Offset(0, 1).Copy
                    toSheet.Range("A1", toSheet.Range("A1").End(xlDown)).Offset(1, 0).Paste
                    gRange.Offset(0, 1).Copy
                    toSheet.Range("E1", toSheet.Range("E1").End(xlDown)).Offset(1, 0).Paste

                    gRange.Offset(0, 2).Copy
                    toSheet.Range("B1", toSheet.Range("B1").End(xlDown)).Offset(1, 0).Paste
                    gRange.Offset(0, 2).Copy
                    toSheet.Range("F1", toSheet.Range("F1").End(xlDown)).Offset(1, 0).Paste

                ElseIf CheckSheet = False Then

                    CreateMySheet catName

                    toSheet = (gRange.Value)

                    gRange.Offset(0, 1).Copy
                    toSheet.Range("A1", toSheet.Range("A1").End(xlDown)).Offset(1, 0).Paste
                    gRange.Offset(0, 1).Copy
                    toSheet.Range("E1", toSheet.Range("E1").End(xlDown)).Offset(1, 0).Paste

                    gRange.Offset(0, 2).Copy
                    toSheet.Range("B1", toSheet.Range("B1").End(xlDown)).Offset(1, 0).Paste
                    gRange.Offset(0, 2).Copy
                    toSheet.Range("F1", toSheet.Range("F1").End(xlDown)).Offset(1, 0).Paste

                End If

            Next gRange

End Sub
Public Function CheckMySheet(ByVal catName As String) As Boolean

    Dim theSheet As Worksheet
    Dim CheckSheet As Boolean

        For Each theSheet In ThisWorkbook.Sheets

            If theSheet.Name = catName Then

                CheckSheet = True
                Exit For

            End If

        Next theSheet

End Function
Public Function CreateMySheet(ByVal catName As String) As Boolean

    Dim catSheet As Worksheet
    Dim newSheet As Worksheet
    Dim Range1 As Range
    Dim gRange As Range

        Set catSheet = Sheets("MasterList")
        Set Range1 = catSheet.Range("A1", catSheet.Range("A1").End(xlDown))

        Set newSheet = Sheets.Add(After:=Sheets("Cover"))
        newSheet.Name = catName

        newSheet.Range("A1") = "Line"
        newSheet.Range("E1") = "Line"
        newSheet.Range("B1") = "Item"
        newSheet.Range("F1") = "Item"
        newSheet.Range("C1") = "Units"
        newSheet.Range("G1") = "Sales"

        CreateMySheet = True

End Function

我已经完整地发布了代码，试图很好地描述我想要完成的工作。我还在考虑一个Do Until循环，CreateMySheet catName以再次检查工作表是否存在，以防止代码向前移动，直到工作表完全创建为止。

谢谢！

4

2 回答 2

5

我认为你仍然需要改进你的复制和粘贴，但是为了让你开始创建工作表，如果列表中不存在，你的一些代码被修改为创建一个新工作表

Option Explicit

Sub BreakOutCategories()

    Dim catSheet As Worksheet
    Dim catName As String
    Dim Range1 As Range
    Dim gRange As Range
    Dim toSheet As Worksheet
    Dim CheckSheet As Boolean
    Dim CreateSheet As Boolean
    Dim i As Long

    Set catSheet = Sheets("MasterList")
    Set Range1 = catSheet.Range("A1", catSheet.Range("A1").End(xlDown))

    For Each gRange In Range1
        i = 0
        catName = gRange.Value
        If CheckMySheet(catName) Then
            Set toSheet = Sheets(gRange.Value)
            ' sheet exists do your copying
        Else
            CreateMySheet catName
            Set toSheet = Sheets(gRange.Value)
            ' sheets didnt exist
        End If
    Next gRange
End Sub

Private Function CheckMySheet(ByVal catName As String) As Boolean
    Dim theSheet As Worksheet
    For Each theSheet In ThisWorkbook.Sheets
        If StrComp(theSheet.Name, catName, vbTextCompare) = 0 Then
            CheckMySheet = True
            Exit For
        End If
    Next theSheet
End Function

Private Function CreateMySheet(ByVal catName As String) As Boolean
    Dim catSheet As Worksheet
    Dim newSheet As Worksheet
    Dim Range1 As Range
    Dim gRange As Range

    Set catSheet = Sheets("MasterList")
    Set Range1 = catSheet.Range("A1", catSheet.Range("A1").End(xlDown))

    Set newSheet = Sheets.Add(After:=Sheets("Cover"))
    newSheet.Name = catName

    newSheet.Range("A1") = "Line"
    newSheet.Range("E1") = "Line"
    newSheet.Range("B1") = "Item"
    newSheet.Range("F1") = "Item"
    newSheet.Range("C1") = "Units"
    newSheet.Range("G1") = "Sales"

    CreateMySheet = True
End Function

更新：
根据您的评论，我认为您需要阅读更多有关函数及其工作原理的信息。如果您计划进行编码/编程，这是您需要学习的相对简单且绝对是基本的东西。我可以推荐Pearsons Guide作为起点。
现在，让我向您展示最简单的示例在继续之前，
请确保您知道a和is之间的区别functionprocedure。

Function ReturnTrue() As Boolean
    ReturnTrue = True
End Function

Function ReturnFalse() As Boolean
    ReturnFalse = False
End Function

上面演示了如何从没有条件的函数返回布尔值。如果你从一个模块中调用它，一个总是返回 true，而另一个总是返回 false。

下面演示了如何根据某些条件从函数返回值。这一次你想要更好RUN地BooleanFunctions()理解代码和结果。我希望这有帮助

Function TrueOrFalse(number As Integer) As Boolean
    If number > 0 And number < 255 Then
        TrueOrFalse = True
    Else
        TrueOrFalse = False
    End If
End Function

Sub BooleanFunctions()
    Dim functionResult As Boolean
    functionResult = TrueOrFalse(10)
    MsgBox functionResult
    functionResult = TrueOrFalse(-10)
    MsgBox functionResult
End Sub

如您所见，函数将返回的值是函数名称，以及作为函数中的最后一次调用分配给它的任何值

于 2013-07-11T14:40:45.787 回答
1

您从不设置函数的值，因此，正如您所注意到的，它返回默认值False. 通过在末尾添加一行来修复它：

Public Function CheckMySheet(ByVal catName As String) As Boolean

    Dim theSheet As Worksheet
    Dim CheckSheet As Boolean

        For Each theSheet In ThisWorkbook.Sheets
            If theSheet.Name = catName Then
                CheckSheet = True
                Exit For
            End If
        Next theSheet

CheckMySheet = CheckSheet 

End Function
于 2013-07-11T14:28:55.200 回答