Question

我有以下代码，但由于某种原因，msgbox krow似乎不起作用。有一个匹配，但它只是显示错误。我不明白为什么。感谢帮助，谢谢！

Sub addsheet()

Dim lrow As Variant, krow As Variant
Dim i As Long, lastcol As Long, lastrow As Long, lastrowcomp As Long
Dim sheetname As String, sheetname2 As String

Sheets("Main Sheet").Activate
lastcol = Cells(2, Columns.Count).End(xlToLeft).Column
lrow = Application.Match(Sheets("Main Sheet").Range("F6").Value, Sheets("Main Sheet").Range(Cells(2, 14), Cells(2, lastcol)), 0)

If IsError(lrow) Then
    MsgBox "Please Select a value under change"
ElseIf lrow > 0 Then
    lastrow = Sheets("Main Sheet").Cells(Rows.Count, lrow + 13).End(xlUp).Row
    lastrowcomp = Sheets("Comparison Check").Range("A" & Rows.Count).End(xlUp).Row

    For i = 3 To lastrow
        krow = Application.Match(Sheets("Main Sheet").Cells(i, lrow).Value, Sheets("Comparison Check").Range("A3:A" & lastrowcomp), 0)
        MsgBox krow

        'If IsError(krow) Then
        'sheetname = Sheets("Main Sheet").Cells(i, lrow + 13).Value
        'Worksheets.Add(After:=Worksheets(1)).Name = sheetname
        'ThisWorkbook.Sheets("Sheet1").UsedRange.Copy
        'ThisWorkbook.Sheets(sheetname).Select
        'ThisWorkbook.Sheets(sheetname).Range("A1").Select
        'ThisWorkbook.Sheets(sheetname).Paste
        'ThisWorkbook.Sheets(sheetname).Cells.Interior.ColorIndex = 2
        'Else
        If krow > 0 Then
            sheetname2 = Sheets("Comparison Check").Cells(krow, 1).Value
            Sheets(sheetname2).Activate

        End If
    Next i
End If

End Sub

基本上，如果没有匹配项，我正在尝试使用名称创建新工作表，如果匹配，则转到现有工作表。但是当有匹配时，它会以某种方式继续创建新表。因此，为什么我添加msgbox krow来确认问题与匹配。

Answer 1

我对您的代码进行了一些小的调整。请看一下，如果现在有效，请告诉我。

Option Explicit

Sub addsheet()

Dim lrow As Variant, krow As Variant
Dim i As Long, lastcol As Long, lastrow As Long, lastrowcomp As Long
Dim sheetname As String, sheetname2 As String

Dim ws As Worksheet, lngCount As Long, strSheets As String

strSheets = "Main Sheet/Comparison Check"
For Each ws In ThisWorkbook.Worksheets
    For i = LBound(Split(strSheets, "/")) To UBound(Split(strSheets, "/"))
        If Split(strSheets, "/")(i) = ws.Name Then lngCount = lngCount + 1
    Next i
Next ws
If lngCount < 2 Then
    MsgBox "One of the required sheets was not found." & Chr(10) & "Aborting!"
    Exit Sub
End If

With ThisWorkbook.Worksheets("Main Sheet")
    lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    lrow = Application.Match(.Range("F6").Value, .Range(.Cells(2, 14), .Cells(2, lastcol)), 0)

    If VarType(lrow) = vbError Then
        MsgBox "Please Select a value under change."
        Debug.Print "Value '" & .Range("F6").Value & "' not found in range " & .Cells(2, 14).Address & ":" & .Cells(2, lastcol).Address
    Else
        lastrow = .Cells(.Rows.Count, lrow + 13).End(xlUp).Row
        lastrowcomp = ThisWorkbook.Worksheets("Comparison Check").Range("A" & .Rows.Count).End(xlUp).Row
        For i = 3 To lastrow
            krow = Application.Match(.Cells(i, lrow).Value, ThisWorkbook.Worksheets("Comparison Check").Range("A3:A" & lastrowcomp), 0)
            If VarType(krow) = vbError Then
                MsgBox CStr(krow)
            Else
                sheetname2 = ThisWorkbook.Worksheets("Comparison Check").Cells(krow, 1).Value
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Name = sheetname2 Then lngCount = lngCount + 1
                Next ws
                If lngCount < 3 Then
                    MsgBox "A sheet by the name '" & sheetname2 & "'  couldn't be found." & Chr(10) & "Aborting!"
                    Exit Sub
                Else
                    ThisWorkbook.Worksheets(sheetname2).Activate
                End If
            End If
        Next i
    End If
End With

End Sub

基本上，上面的代码几乎与你的代码相同，但有更多的错误处理。因此，代码中的假设更少，而更多的检查。如果某些内容无法正常工作，那么您可以在VBE的Immediate Window中获得消息框或通知行。

另外，我更明确地编码了。这意味着我真的告诉VBA我想要什么，不允许任何解释。例如：当您撰写lastcol = Cells(2, Columns.Count).End(xlToLeft).Column时，您的意思是说您想引用工作表Columns.Count的最后一列（Main Sheet）。然而，由于您事先激活了工作表，因此未在该行中明确说明并仅由VBA编译器推断。我将所有这些改为显式编码，这消除了（大部分时间）已经很麻烦。

尝试使用变量时MsgBox错误

1 个答案: