在VBA中返回一個布爾值

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 

我已經發布了完整的代碼，試圖給出我想要完成的一個很好的圖片。我還在CreateMySheet catName之後考慮Do Until循環來再次檢查表單的存在，以防止代碼向前移動，直到表單完全創建。

謝謝！

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 

UPDATE：
而且您的意見，我認爲你需要閱讀更多的有關功能以及它們如何工作。如果您計劃編碼/編程，那麼您需要學習相對簡單且絕對基本的東西。我可以推薦Pearsons Guide作爲起點。
現在，讓我告訴你最簡單的例子容易
確保你知道function和procedure之間的區別是什麼你移動之前。

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 

正如你可以看到有值將是由函數返回的是函數名稱，無論是分配給它的最後調用函數中的

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