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 に答える