Excel vba以前正在運行的代碼的運行時錯誤「13」

Question

我在Excel vba中遇到以下代碼問題。以前行rSurname = Range ("A" + numrows).Value工作正常，但我已經在代碼中添加了檢查值是否已經存在的範圍「D：D」，現在我得到運行時錯誤13消息

本質上是我「M試圖做的是：

1. 檢查一個姓只有5個字符
2. 如果一個姓少於5個字符，墊5位
3. 如果一個姓已超過500個字符，修剪到5個字符
4. 添加數字後綴填充到4個數字（即0001）
5. 檢查輸出已經不存在了，如果不能打印到範圍「d：d」
6. 如果值確實存在，增量後綴，重複檢查，直到獨特價值

我的代碼低於

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

這裏有一個更簡單的版本：

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 

Answer 2

可能更好地得到RIT過濾網和使用工作表函數像

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