Question

我有两张相同值的两列，我希望我的脚本在两个值匹配时创建一个新的工作表，其中第二个工作表的第二列中的值名称与找到的值相邻。

下面的脚本在第一次匹配时停止，我希望继续进行所有可能的匹配。

 Public Sub try()
    Dim lastRow As Long
    Dim i As Long, j As Long, b As Long, Fente As String, newente As Worksheet
    With Worksheets("totale")
      lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    For i = 2 To lastRow

       With Worksheets("totale")
           If .Cells(i, 5).Value = Worksheets("liste").Cells(i, 2).Value Then
             Fente = Worksheets("liste").Cells(i, 1).Value
             Set newente = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
             newente.Name = Fente

             i = i + 1
           End If
       End With
    Next i      
 End Sub

Answer 1

你的代码几乎没有问题有一个问题，但不是你描述的问题，我注意到的问题是你手动增加i，这将导致i = i + 2，当找到匹配时，下一行将不会被检查，因为匹配时会跳过每一行。

我认为问题在于，在确定循环的结束值或指向名称的不正确的列/表时，您可能会查看错误的记录。您的最后一行程序检查“Totale”列A，但您比较的值是“Liste”中的列“B”和totale中的“E”列，并根据“Liste”列“A”中的名称创建一个表单。如果这不正确，您可能需要更改指针。

所以你的循环将重复自己在Totale中的记录数量。“A”结束然后停止，如果Liste.A将是空白或将包含非法字符，你将收到错误所以我包括额外的检查在下面的代码中。

Public Sub try()
Dim lastRow As Long
Dim i As Long, j As Long, b As Long, Fente As String, newente As Worksheet

With Worksheets("totale")
   lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For i = 2 To lastRow

   With Worksheets("totale")
       If .Cells(i, 5).Value = Worksheets("liste").Cells(i, 1).Value Then
            Fente = Worksheets("liste").Cells(i, 1).Value
            Set newente = ThisWorkbook.Sheets.Add(After:= _
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            'check if name is valid and not empty cell
            If FileNameValid(Fente) And Fente <> "" Then
                newente.Name = Fente
            Else
            'if not save as illegal name
                newente.Name = "bad_name_row_" & i
            End If
            'i = i + 1  - REMOVE THIS PART. You skip additional line when they are the same
            '              this is executed and then Next i also increments by one
        End If
End With
Next i

End Sub

'check if valid file name is used in cell
Function FileNameValid(sFileName As String) As Boolean
Dim notAllowed As Variant
Dim i As Long
Dim result As Boolean
'list of forbidden characters
notAllowed = Array("/", "\", ":", "*", "?", "&lt; ", ">", "|", """")
'Initial result = OK
result = True
For i = LBound(notAllowed) To UBound(notAllowed)
    If InStr(1, sFileName, notAllowed(i)) > 0 Then
    'forbidden character used
        result = False

        Exit Function
    End If
Next i
FileNameValid = result
End Function

更新

使用刚刚添加的屏幕，可以确定您指向宏中的错误单元格。交换那些指针并删除i + 1应该这样做。 Cells(i, 5).Value = Worksheets("liste").Cells(i, **1**).Value Then Fente = Worksheets("liste").Cells(i, **2**).Value

尝试上面的完整更新代码。

Answer 2

我解决了这个问题。

这是我的代码：

Public Sub try()
Dim lastRow As Long, lrow As Long
Dim i As Long, c As Long, Fente As String, newente As Worksheet

With Worksheets("totale")
   lastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
With Worksheets("liste")
   lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

For i = 2 To lastRow
For c = 2 To lrow

   With Worksheets("totale")
       If .Cells(i, 5).Value = Worksheets("liste").Cells(i, 2).Value Then
            Fente = Worksheets("liste").Cells(c, 1).Value
            'skip to next value if sheet exists
            If sheetExists(Fente) = True Then
                On Error Resume Next
            Else
                Set newente = ThisWorkbook.sheets.Add(After:= _
                ThisWorkbook.sheets(ThisWorkbook.sheets.Count))
                If FileNameValid(Fente) And Fente <> "" Then
                    newente.Name = Fente
                Else
                'if not save as illegal name
                    newente.Name = "bad_name_row_" & i
                End If
            'NOTE: this will overwrite name set by ELSE
            newente.Name = Fente

            End If
       End If
       End With
       Next c
       Next i
End Sub

'check if valid file name is used in cell
Function FileNameValid(sFileName As String) As Boolean
Dim notAllowed As Variant
Dim i As Long
Dim result As Boolean
'list of forbidden characters
notAllowed = Array("/", "\", ":", "*", "?", "&lt; ", ">", "|", """")
'Initial result = OK
result = True
For i = LBound(notAllowed) To UBound(notAllowed)
    If InStr(1, sFileName, notAllowed(i)) > 0 Then
    'forbidden character used
        result = False
        Exit Function
    End If
Next i
FileNameValid = result
End Function

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

谢谢大家。

如果两张纸的值匹配，则添加新纸张

2 个答案:

更新