Question

我在Excel vba中遇到以下代码问题。以前行rSurname = Range ("A" + numrows).Value工作正常，但我在代码中添加了检查值是否已存在于“D：D”范围内，现在我收到运行时错误13消息

基本上我要做的是：

检查姓氏只有5个字符
如果一个姓氏少于5个字符，请填入空格<5“
如果一个姓氏有超过5个字符，则修剪为5个字符
添加数字后缀填充为4个数字（即0001）
检查输出是否已经存在，如果不打印到范围“D：D”
如果值确实存在，请增加后缀并重复检查，直到值唯一

我的代码在

Private Sub TestButton_Click()

Dim rSurname, rOutput, sLength, numrows, sFindString As String
Dim nSuffix As Integer
Dim rRange As Range
Dim iLength As Long



numrows = 1
    'Set Cell A2 as first cell range
    Range("A2").Select
    'Set loop to stop when en empty cell is reached
    Do
    'Increment numrows
    numrows = numrows + 1
    'Set Surname value
    rSurname = Range("A" + numrows).Value
    'Check Surname Letter Count and ensure 5 chars in Surname
    iLength = Len(rSurname)
    If iLength > 5 Then
             rSurname = Left(rSurname, 5)
    ElseIf iLength = 4 Then
        rSurname = rSurname & " "
    ElseIf iLength = 3 Then
        rSurname = rSurname & "  "
    ElseIf iLength = 2 Then
        rSurname = rSurname & "   "
    ElseIf iLength = 1 Then
        rSurname = rSurname & "    "
    Else
        rSurname = rSurname
End If


'Set Suffix value
nSuffix = 1
    Do
    'Combine Surname and suffix
    rOutput = rSurname & Format(nSuffix, "0000")
            'Check whether Output in list range
            sFindString = "rOutput"
            If Trim(FindString) <> "" Then
                With Sheets("Sheet1").Range("D:D")
                    Set Rng = .Find(What:=FindString, _
                                    After:=.Cells(.Cells.Count), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                 rOutput = rOutput
                Else
                    nSuffix = nSuffix + 1
                End If
            End With
        End If
        Loop

    'Add Outputs to Columns
    Range("B" + numrows).Value = rSurname
    Range("C" + numrows).Value = nSuffix 
    Range("D" + numrows).Value = rOutput

    Loop Until IsEmpty(rSurname)
End Sub

Answer 1

最好从过滤器中取出rit并使用像

这样的工作表函数

iFoundStrings = 
   Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("D:D"), 
   FindString)

Answer 2

这是一个更简单的版本：

Sub CreateStrings()
    Dim rng As Range
    Dim i As Long, s As String
    Dim cl As Range
    Dim v

    Set rng = Range([A2], Me.[A2].End(xlDown))
    For Each cl In rng.Cells
        s = cl.Value
        If Len(s) < 5 Then
            s = s & Space(5 - Len(s))
        Else
            s = Left(s, 5)
        End If
        i = 1
        v = Application.Match(s & Format(i, "0000"), Me.[D:D], 0)
        Do While Not IsError(v)
            i = i + 1
            v = Application.Match(s & Format(i, "0000"), Me.[D:D], 0)
        Loop
        cl.Offset(, 3) = s & Format(i, "0000")
    Next
End Sub

Excel vba运行时错误＆＃39; 13＆＃39;在以前工作的代码上

2 个答案: