如果两张纸张的值匹配，则添加新纸张
我有两个具有相同值的两列，我希望我的脚本，当两个值匹配时创build一个新的工作表名称值在第二个工作表的第二列中find的值附近的值。
下面的脚本停在第一个匹配，我希望这个过程继续所有可能的匹配。
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 你的代码工作几乎没有问题，但有一个问题，但不是你所描述的问题，我注意到，你手动增加我会导致i = i + 2当发现匹配和下一行将不会被检查，因为它会跳过每隔一行就匹配一次。
我认为问题在于，在确定循环结束值或指向名称不正确的列/表时，可能会查看错误的logging。 您的最后一行程序检查“Totale”列A，但您比较的值是“Liste”中的列“B”和totale中的“E”列，并根据“Liste”列“A”中的名称创build工作表。 如果这是不正确的，你可能需要改变你的指针。
所以你的循环会重复自己多次Totalelogging“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("/", "\", ":", "*", "?", "< ", ">", "|", """") '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
UPDATE
随着你刚刚添加的屏幕，你可以肯定的是你指向错误的macros单元格。 交换这些指针，并删除该i + 1应该做到这一点。 Cells(i, 5).Value = Worksheets("liste").Cells(i, **1**).Value Then Fente = Worksheets("liste").Cells(i, **2**).Value
尝试从上面完整更新的代码。
我解决了这个问题。
这是我的代码：
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("/", "\", ":", "*", "?", "< ", ">", "|", """") '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
谢谢你们。