Question

我有一段代码应该按名称检查是否存在工作表。如果工作表存在，则有一些复制和过去的功能，如果工作表不存在，那么它将创建，并且将跟随相同的复制过去的功能。我无法获得正确的布尔值来返回主子。布尔值始终注册为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循环来再次检查是否存在工作表，以防止代码向前移动直到工作表完全创建。

谢谢！

Answer 1

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

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作为起点。
现在，让我向您展示最简单的简单示例。确保您在继续之前了解function和procedure之间的差异。

Function ReturnTrue() As Boolean
    ReturnTrue = True
End Function

Function ReturnFalse() As Boolean
    ReturnFalse = False
End Function

上面演示了如何从没有条件的函数返回布尔值。如果你从一个模块中调用它，那么它将始终返回true而其他的总是为假。

下面演示了如何根据某些条件从函数返回值。这一次，您希望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

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

Answer 2

您永远不会设置函数的值，因此，如您所知，它会返回默认值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

在VBA中返回布尔值

2 个答案: