如果两张纸匹配,则添加新的纸张 [英] 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("/", "\", ":", "*", "?", "< ", ">", "|", """")
'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屋!