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

我有两个工作表，其中两列的值相等，我希望在两个值匹配时使用脚本在第二个工作表中与找到的值相邻的第二列中创建一个名为value的新工作表

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

---

您的代码几乎可以正常工作有一个问题，但与您描述的不同。我注意到的问题是，您手动增加I，当找到匹配项时，这将导致I=I+2，并且不会选中下一行，因为在匹配项时，它将跳过每一行

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

因此，您的循环将重复自身，重复次数与您总共拥有的记录数相同。“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

Public-Sub-try（）
最后一排一样长
尺寸i为长，j为长，b为长，芬特为字符串，纽恩特为工作表
带工作表（“总计”）
lastRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
以
对于i=2到最后一行
带工作表（“总计”）
如果.Cells（i，5）.Value=工作表（“列表”）.Cells（i，1）.Value，则
Fente=工作表（“列表”）。单元格（i，1）。值
Set newente=thiswoolk.Sheets.Add（之后：=_
ThisWorkbook.Sheets（ThisWorkbook.Sheets.Count））
'检查名称是否有效且不是空单元格
如果filenamefalid（Fente）和Fente“”，则
newente.Name=Fente
其他的
'如果不是，另存为非法名称
newente.Name=“坏名称”行（&i）
如果结束
'i=i+1-拆下此零件。当它们相同时，可以跳过其他行
'这将被执行，然后下一步我也将增加1
如果结束
以
接下来我
端接头
'检查单元格中是否使用了有效的文件名
函数FileNameValid（sFileName为字符串）为布尔值
不允许作为变体
我想我会坚持多久
将结果设置为布尔值
'禁止字符列表
notAllowed=数组（“/”、“\”、“：”、“*”、“？”、“>”、“|“、”）
'初始结果=正常
结果=真
对于i=LBound（不允许）到UBound（不允许）
如果InStr（1，sFileName，notAllowed（i））>0，则
"禁字",
结果=错误
退出功能
如果结束
接下来我
filenamefalid=result
端函数

更新 对于刚才添加的屏幕，可以肯定的是，您在宏中指向了错误的单元格。交换这些指针并删除i+1应该可以做到这一点。

Cells（i，5）.Value=Worksheets（“liste”）.Cells（i，**1**）.Value然后
Fente=工作表（“列表”）。单元格（i，**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

Public-Sub-try（）
最后一行变暗，最后一行变长，最后一行变暗，最后一行变长
尺寸i为长，c为长，芬特为字符串，纽恩特为工作表
带工作表（“总计”）
lastRow=.Cells（.Rows.Count，“E”）.End（xlUp）.Row
以
带工作表（“列表”）
lrow=.Cells（.Rows.Count，“B”）.End（xlUp）.Row
以
对于i=2到最后一行
对于c=2至lrow
带工作表（“总计”）
如果.Cells（i，5）.Value=工作表（“liste”）.Cells（i，2）.Value，则
Fente=工作表（“列表”）。单元格（c，1）。值
'如果工作表存在，则跳到下一个值
如果存在（芬特）=真，则
出错时继续下一步
其他的
Set newente=thiswoolk.sheets.Add（之后：=_
ThisWorkbook.sheets（ThisWorkbook.sheets.Count））
如果filenamefalid（Fente）和Fente“”，则
newente.Name=Fente
其他的
'如果不是，另存为非法名称
newente.Name=“坏名称”行（&i）
如果结束
'注意：这将覆盖ELSE设置的名称
newente.Name=Fente
如果结束
如果结束
以
下一个c
接下来我
端接头
'检查单元格中是否使用了有效的文件名
函数FileNameValid（sFileName为字符串）为布尔值
不允许作为变体
我想我会坚持多久
将结果设置为布尔值
'禁止字符列表
notAllowed=数组（“/”、“\”、“：”、“*”、“？”、“>”、“|“、”）
'初始结果=正常
结果=真
对于i=LBound（不允许）到UBound（不允许）
如果InStr（1，sFileName，notAllowed（i））>0，则
"禁字",
结果=错误
退出功能
如果结束
接下来我
filenamefalid=result
端函数
函数sheetExists（sheetToFind为字符串）为布尔值
sheetExists=False
对于工作表中的每张图纸
如果sheetToFind=Sheet.Name，则
sheetExists=True
退出功能
如果结束
下一页
端函数

---

谢谢大家。

您必须将i=i+1移动到Ifi尝试的外部，但循环总是在第一次匹配时停止，只添加一张纸。在两端Ifs之前的行中，您有

newente.Name=Fente

。如果else语句将工作表的名称设置为bad_name_row_i，则该名称将被覆盖。此外，由于名称无效，将导致运行时错误。您可以删除该行，因为上面的IF语句将分配此名称或坏名称，或者在Else之前将该行移动到IF case。最好的方法是将其保持为：

If（filenamefalid（Fente）和Fente“”）或sheetExists（Fente），然后

，这样也可以删除上面的If-ELSE。

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