2013-11-03 44 views
0

下面的代碼我在Excel工作表上。我使用VBA來改變某些單元格的內容,以便爲我的工作正確地格式化它們。我們保留損壞清單,海灣位置和VIN。這些列中的每一列都有其自己的特定格式,其中2個我工作正常。你們中的一些人可能會從另一篇文章中識別出一些代碼,這些代碼是關於讓損壞代碼格式正確的。列被排序爲這樣VBA腳本工作,突然拋出錯誤?

Bay Location | VIN | Damage Code(s) 

對於VIN,我們所做的一切是大寫字母。簡單,完成了。損壞代碼功能完美適用後,我已經改變了一下,以更好地滿足我的需求。如果沒有我在這裏收到的原始幫助,不可能做到這一點。在這裏,事情變得怪怪的,我的老闆,看到我已經得到這個爲損壞代碼工作,讓我讓它自動格式化海灣。在我工作的托架位置有幾個可能性,但總有至少1個字母前面如

  1. H-5
  2. H-125
  3. HH-50
  4. 7A-70
  5. FNCE-13

在英語中,我想要做的是: 輸入格式化的海灣,如7a12,大寫字母,由數字拆分它,並添加衝進兩個團體之間,瞧。

我有這個工作,甚至顯示給我的老闆。但後來我的代碼添加到大寫VIN列,我開始收到錯誤,突出線

Set allMatches = RE1.Execute(strSource) 

的RE1.test(strSource)運行正常,但試圖抓住火柴/子匹配現在拋出神祕一個錯誤。我最初使用This StackOverflow question的文本來使它工作。我得到的錯誤類似於它告訴我該對象沒有設置。我知道代碼目前是一團糟,我不得不離開中間工作(認爲可能是我的函數有問題,不過,從原始子函數直接運行時出現相同的錯誤)。

編輯:作爲遵循的錯誤

運行時錯誤 '91' 對象變量或帶塊變量未設置

再次,它突出

allMatches = RE.Execute(str) 

任何幫助表示讚賞。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Dim str As String, result As String 
    Dim RE As Object 
    Dim allMatches As Object 

    ' The variable KeyCells contains the cells that will 
    ' cause an alert when they are changed. 
    Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100")) 
    Set RE = CreateObject("vbscript.regexp") 

    If Not TypeName(Target.Value) = "Variant()" Then 

     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      ' Display a message when one of the designated cells has been 
      ' changed. 
      ' Place your code here. 
      str = ConvertString(Target) 
      If (Not str = Target.Value And Not Target.Value = "") Then 
       Target.Value = str 
      End If 

     End If 

     ' Now we have to check the bays in order to auto format 
     Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100")) 
     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})" 
      RE.Global = True 

      If Not Target.Value = "" And Not RE.test(Target.Value) Then 
        str = CStr(Target.Value) 
        RE.IgnoreCase = True 
        allMatches = RE.Execute(str) 
        MsgBox allMatches.Count 

        Target.Value = str 
      End If 

     End If 

     Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100")) 

     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      RE.Pattern = "[a-z]?" 
      RE.IgnoreCase = False 

      If RE.test(Target.Value) Then 
       Target.Value = UCase(Target.Value) 
      End If 

     End If 
    End If 
End Sub 
Function FormatBay(str1 As Range) As String 
    Dim result As String, strSource As String 
    Dim allMatches As Object 
    Dim RE1 As Object 
    Set RE1 = CreateObject("vbscript.regexp") 
    RE1.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})" 
    RE1.Global = True 
    strSource = CStr(str1.Value) 
    Set allMatches = RE1.Execute(strSource) 
    result = "FF-12" 
    If allMatches.Count <> 0 Then 
     result = allMatches.Item(0) 
    End If 
    MsgBox result 
    FormatBay = result 
End Function 
Function ConvertString(str1 As Range) As String 
    Dim varStr As Variant 
    Dim strSource As String, strResult As String 
    Dim i As Integer 

    For Each varStr In Split(Trim(str1.Value), " ") 

      strSource = CStr(varStr) 
     If InStr(strSource, ".") = 0 Then 
      strResult = strResult & _ 
       Mid(strSource, 1, 2) & "." & _ 
       Mid(strSource, 3, 2) & "." & _ 
       Mid(strSource, 5, 1) 
      If Len(strSource) > 5 Then 
       strResult = strResult & "(" 
       For i = 6 To Len(strSource) 
        strResult = strResult & Mid(strSource, i, 1) & "," 
       Next i 
       strResult = Left(strResult, Len(strResult) - 1) & ")" 
      End If 
      strResult = strResult & " " 
     Else 
      strResult = strResult & strSource & " " 
     End If 
    Next 

    If strResult = "" Then 
     ConvertString = "" 
    Else 
     ConvertString = Left(strResult, Len(strResult) - 1) 
    End If 
End Function 

編輯:這裏是我得到了什麼工作,我知道這有點長,可能冗長,但我剛學VBA所以當我學習更好的方式來做到這一點,我將編輯這篇文章,希望以後幫助別人。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Dim str As String, result As String 
    Dim RE As Object 
    Dim allMatches As Object 

    ' The variable KeyCells contains the cells that will 
    ' cause an alert when they are changed. 
    Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100")) 
    Set RE = CreateObject("vbscript.regexp") 

    If Not TypeName(Target.Value) = "Variant()" Then 


     ' Now we have to check the bays in order to auto format 
     Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100")) 
     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})" 
      RE.Global = True 

      If Not Target.Value = "" And Not RE.test(Target.Value) Then 
        str = CStr(Target.Value) 
        str = FormatBay(str) 

        Target.Value = str 
      End If 

     End If 

     Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100")) 

     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      RE.Pattern = "[a-z]?" 
      RE.IgnoreCase = False 

      If RE.test(Target.Value) Then 
       Target.Value = UCase(Target.Value) 
      End If 

     End If 

     Set KeyCells = Application.Union(Range("C3:C100"), Range("F3:F100"), Range("I3:I100")) 

     If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

      ' Display a message when one of the designated cells has been 
      ' changed. 
      ' Place your code here. 
      str = ConvertString(Target) 
      If (Not str = Target.Value And Not Target.Value = "") Then 
       Target.Value = str 
      End If 

     End If 

    End If 
End Sub 
Function FormatBay(ByVal text As String) As String 

    Dim result As String, bayLetter As String, bayNumber As String 
    Dim length As Integer, i As Integer 
    Dim allMatches As Object 
    Dim RE As Object 
    Set RE = CreateObject("vbscript.regexp") 

    RE.Pattern = "([0-9]?[a-z]{1,})\-?([0-9]{1,3})" 
    RE.Global = True 
    RE.IgnoreCase = True 

    Set allMatches = RE.Execute(text) 

    If Not allMatches.Count = 0 Then 
     bayLocation = allMatches.Item(0).submatches.Item(0) 
     bayLocation = UCase(bayLocation) 
     bayNumber = allMatches.Item(0).submatches.Item(1) 
     length = Len(bayNumber) 

     For i = 1 To (3 - length) 
      bayNumber = "0" & bayNumber 
     Next 
     result = bayLocation & "-" & bayNumber 
    End If 

    FormatBay = result 

End Function 
Function ConvertString(str1 As Range) As String 
    Dim varStr As Variant 
    Dim strSource As String, strResult As String 
    Dim i As Integer 

    For Each varStr In Split(Trim(str1.Value), " ") 

      strSource = CStr(varStr) 
     If InStr(strSource, ".") = 0 And IsNumeric(strSource) Then 
      strResult = strResult & _ 
       Mid(strSource, 1, 2) & "." & _ 
       Mid(strSource, 3, 2) & "." & _ 
       Mid(strSource, 5, 1) 
      If Len(strSource) > 5 Then 
       strResult = strResult & "(" 
       For i = 6 To Len(strSource) 
        strResult = strResult & Mid(strSource, i, 1) & "," 
       Next i 
       strResult = Left(strResult, Len(strResult) - 1) & ")" 
      End If 
      strResult = strResult & " " 
     Else 
      strResult = strResult & strSource & " " 
     End If 
    Next 

    If strResult = "" Then 
     ConvertString = "" 
    Else 
     ConvertString = Left(strResult, Len(strResult) - 1) 
    End If 
End Function 
+0

添加了我得到的答案。 – Jhecht

回答

1

allMatches是一個對象(類型= MatchCollection)變量。分配對象變量時,應該使用Set關鍵字。

Set allMatches = RE.Execute(str) 

當你的代碼目前維持,我不認爲它永遠可以在不提高這個錯誤很成功,除非你或其他人做了一個無意編輯的代碼,改變了這個變量被分配的方式。

希望這有助於!

+0

我之前刪除了它,它一直在工作(也許是一個緩存版本?),然後它突然沒有。我嘗試添加該部分,但它沒有奏效。我努力通過它成功地實現了它的工作。 – Jhecht

0

首先,正則表達式[a-z]?總是要匹配。如果Target.Value中的第一個字符恰好是小寫字母,則正則表達式將使用它。否則它會匹配之前的空字符串的第一個字符。您正在測試是否存在小寫字母,但?通過將該字母設爲可選來擊敗目的。

但我不明白你爲什麼需要做那個測試。無論如何你會把所有的字母改爲大寫,對吧?所以只需UCase這個字符串就可以完成了。或者等到轉換完成並且UCase那麼。

至於實際的轉換,你的代碼相當混亂,但我認爲你做了大量不必要的工作。如果您正在處理串像7a12獨立,這應該足夠了:

RE.Pattern = "^([0-9]?[A-Z]{1,})-?([0-9]{1,3})$" 
RE.IgnoreCase = True 
result = UCase(RE.Replace(source, "$1-$2")) 

還是我失去了一些東西?

+0

不,我只是不知道正則表達式對象的替換函數。真是VBA新手。 – Jhecht

相關問題