如果两张纸匹配，则添加新的纸张 [英] If values of two sheets match then add new sheet

问题描述

我有两张具有相同值的两个列，当两个值相匹配时，我希望我的脚本创建一个新值，其值与第二个列的第二列中的值相邻。 >

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

  Public Sub try（）
 Dim lastRow As Long 
 Dim i As Long，j As Long，b As Long，Fente As String，anente As Worksheet 
 With Worksheets（totale）
 lastRow = .Cells（.Rows.Count， A）。End（xlUp）.Row 
结束
 
对于i = 2 To lastRow 
 
使用Worksheets（totale）
如果.Cells（i，5）.Value = Worksheets（liste）。Cells（i，2）.Value Then 
 Fente = Workshee ts（liste）。单元格（i，1）.Value 
设置newente = ThisWorkbook.Sheets.Add（之后：= _ 
 ThisWorkbook.Sheets（ThisWorkbook.Sheets.Count））
 newente.Name = Fente 
 
i = i + 1 
结束如果
结束
下一步i 
结束Sub 
  

解决方案

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

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

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

  public Sub try（）
 Dim lastRow As Long 
 Dim i As Long，j As Long，b As Long，Fente As String，anente As Worksheet 
 
 With Worksheets （totale）
 lastRow = .Cells（.Rows.Count，A）。End（xlUp）.Row 
 End with 
 
 For i = 2 To lastRow 
 
与工作表（totale）
如果.Cells（i，5）.Value = Worksheets（liste）。单元格（i，1）.Value Then 
 Fente = Worksheets（liste）。Cells（i，1）.Value 
 Set newente = ThisWorkbook.Sheets.Add（After：= _ 
 ThisWorkbook.Sheets（ThisWorkbook.Sheets.Count））
'检查名称是否有效，而不是空单元格
如果FileNameValid（Fente）和Fente 然后
 newente.Name = Fente 
 Else 
'如果不保存为非法名称
 newente.Name =bad_name_row_& i 
 End If 
'i = i + 1  - 删除此部分。当您执行相同的
'时，您跳过另外的行，然后Next我也会增加一个
 End If 
 End With 
 Next i 
 
 End Sub 
 
'检查在单元格
中是否使用有效的文件名函数FileNameValid（sFileName As String）As Boolean 
 Dim notAllowed As Variant 
 Dim i As Long 
 Dim result As Boolean 
'禁止字符列表
 notAllowed = Array（/，\，：，*，？，& lt ;，）
'初始结果= OK 
 result = True 
对于i = LBound（notAllowed）到UBound（notAllowed）
如果InStr（1，sFileName，notAllowed（i））> 0然后
'禁止使用的字符
 result = False 
 
退出函数
结束如果
下一个我
 FileNameValid = result 
结束功能
  

更新

你刚刚添加的确定你指向宏中错误的单元格。交换这些指针并删除i + 1应该这样做。
Cells（i，5）.Value = Worksheets（liste）。Cells（i，** 1 **）。Value Then
Fente = Worksheets（liste ）.Cells（i，** 2 **）。值

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

I have two sheets that have two columns with equal values, I want my script when the two values match create a new sheet with the name of value in a second column of the second sheet adjacent to the value found.

The script below stops at the first matching, I wish that the process continues for all possible matches.

 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

解决方案

Your code works almost OK there is one issue but not as you describe it the issue that I noticed is that you manually increment i which will result in i=i+2 when match is found and next line will not be checked as it will skip every second line when matched.

I believe the problem is that you might look at wrong records when determining end value of loop or pointing to incorrect columns/sheets for names. Your last row procedure check "Totale" column A but the values you compare are column "B" in "Liste" and column "E" in totale and creates a sheet based on name in "Liste" column "A". If that is incorrect you might need to change your pointers.

So your loop will repeat itself as many times as many records you have in Totale."A" end then stop, additionally you will get an error if Liste.A will be blank or will contain illegal character so I included additional check in the code below.

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

UPDATE

With the screens you just added it is certain that you point to wrong cells in macro. Swapping those pointers and removing that i+1 should do it. Cells(i, 5).Value = Worksheets("liste").Cells(i, **1**).Value Then Fente = Worksheets("liste").Cells(i, **2**).Value

Try the full updated code from above.

这篇关于如果两张纸匹配，则添加新的纸张的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！