这个脚本可以工作但在第一个脚本之后停止,我希望它能产生两个结果,所以如果空白单元格选择Case pf.Cells(i, 7).Value
,然后继续检查包含数据的单元格并执行所需的大小写。
目前在任何一次行动后都会停止。
Sub NewPortName03()
Dim pf As Worksheet, pi As Worksheet, eq As Worksheet
Dim Rws As Long, Rng As Range, c As Range, cr
Dim s0 As String, s1 As String, s2 As String, s3 As String, s4 As String
Set pf = Sheets("PAR Form")
Set pi = Sheets("PAR_import")
Set eq = Sheets("Equipment details")
s0 = "CAT6A"
s1 = "RJ45"
s2 = "LC-LC"
s3 = eq.Cells(4, 4).Value
s4 = ""
With pf
Rws = .Cells(.Rows.Count, "P").End(xlUp).Row
Set Rng = .Range(.Cells(2, "P"), .Cells(Rws, "P"))
End With
For Each c In Rng.Cells
cr = c.Row
If c = s4 Then
pi.Cells(cr + 48, 3).Value = pf.Cells(cr + 0, 26).Value
ElseIf c = 1 Then
For i = 2 To 34
Select Case pf.Cells(i, 7).Value
Case "CAT6A"
pi.Cells(i + 48, 3).Value = "PCI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 7)
Case "RJ45"
pi.Cells(i + 48, 3).Value = "PCI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 7)
Case "LC-LC"
pi.Cells(i + 48, 3).Value = "PFI-" + eq.Cells(4, 4).Value + "-" + Left(pf.Cells(i, 16), 10) + ":" + pf.Cells(i, 40) + " to " + Left(pf.Cells(i, 17), 10) + ":" + pf.Cells(i, 42)
End Select
Next i
End If
Next c
End Sub
答案 0 :(得分:2)
我稍微收紧了你的代码并用For Next替换了For Each。这组字符串被填充到一个数组中,导致相同结果的Case条件被堆叠在一起。
Sub NewPortName03()
Dim pf As Worksheet, pi As Worksheet, eq As Worksheet
Dim Rws As Long, cr As Long
Dim vSTRs As Variant
Set pf = Sheets("PAR Form")
Set pi = Sheets("PAR_import")
Set eq = Sheets("Equipment details")
vSTRs = Array("CAT6A", "RJ45", "LC-LC", eq.Cells(4, 4).Value2)
With pf
Rws = .Cells(Rows.Count, "P").End(xlUp).Row
For cr = 2 To Rws
If Not CBool(Len(.Cells(cr, "P").Value2)) Then
pi.Cells(cr + 48, 3) = .Cells(cr + 0, 26).Value
ElseIf .Cells(cr, "P").Value2 = 1 Then
For i = 2 To 34
Select Case UCase(.Cells(i, 7).Value2)
Case vSTRs(0), vSTRs(1)
pi.Cells(i & 48, 3) = "PCI-" & vSTRs(3) & "-" & Left(.Cells(i, 16), 7)
Case vSTRs(2)
pi.Cells(i & 48, 3) = "PFI-" & vSTRs(3) & "-" & Left(.Cells(i, 16), 10) & ":" & .Cells(i, 40) & " to " & Left(.Cells(i, 17), 10) & ":" & .Cells(i, 42)
End Select
Next i
End If
Next cr
End With
End Sub
我仍然担心的一件事是,您正在使用.End(xlUp)
来确定 PAR表单工作表列P中行的范围。当您遍历P列中的值时,还会查找空白单元格。列P中是否存在散布的空白单元格,还是应该将For Next循环的范围基于另一列?换句话说,如果列N转到第100行但列P只转到第75行,那么For Next循环当前只会转到第75行。