需要一个额外的循环,所以如果范围为0的单元格然后执行此操作,否则如果范围内的单元格有数据则继续

时间:2015-05-14 12:10:07

标签: excel vba excel-vba

这个脚本可以工作但在第一个脚本之后停止,我希望它能产生两个结果,所以如果空白单元格选择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

1 个答案:

答案 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行。