在macros中引用用户函数的最佳方法
下午，
我目前有这个用户function保存：
Function AlphaNumericOnly(strSource As String) As String Dim i As Integer Dim strResult As String For i = 1 To Len(strSource) Select Case Asc(Mid(strSource, i, 1)) Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space strResult = strResult & Mid(strSource, i, 1) End Select Next AlphaNumericOnly = strResult End Function 我在运行的一些macros中调用这个用户函数（检查它是否在macros中打开）。 我遇到的问题是当我需要分享一个macros引用这个与另一个用户。
我当然可以复制用户函数，并将其与macros的副本一起发送，然后可以将其保存在本地，并调整macros以检查其本地副本是否打开。 但是这似乎很长时间了。
有人可以提供任何build议吗？ 我想知道如果我可以以某种方式embeddedmacros中的用户function，或集中存储一些如何。 一些networkingsearch和问询已经在这一个空白。
谢谢。
请在结尾处查看完整的macros以及用户function：
Option Explicit Public Const csFORMULA = "=concatenate(""AGSBIS"",IF(I2=0,"""",CONCATENATE(UPPER(AlphaNumericOnly(LEFT(I2,3))),UPPER(AlphaNumericOnly(RIGHT(I2,3))))),IF(O2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(O2,""0"","""")))),IF(R2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(R2,""0"","""")))),IF(W2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(W2,""0"","""")))),IF(AC2=0,"""",AlphaNumericOnly(SUBSTITUTE(AC2,""0"",""""))),IF(AD2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AD2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AF2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AF2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AH2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AH2,""-"",""X""),""."",""Y""),""0"",""Z"")))" Sub AgeasBIS() Dim lr As Long Dim cl As Range Dim Rng As Range Dim mssg As String Dim WS As Worksheet Dim SaveToDirectory As String Dim DateFormat As String Dim StatementName As String Dim Organisation As String Dim ErrorMessage As String Dim ErrorMessageTitle As String Dim CompleteMessage As String Dim CompleteMessageTitle As String Dim UserFunctionsLocation As String Dim SaveLocation As String DateFormat = Format(CStr(Now), "yyyy_mm_dd_hhmmss_") ErrorMessageTitle = "Invalid Date Format" ErrorMessage = "There are invalid date value(s) in the following cell(s). Please check these cells." CompleteMessageTitle = "Statement Preparation" CompleteMessage = "Statement preparation is complete. Your file has been saved and will be processed as part of the next scheduled upload." StatementName = "age_bts" Organisation = "BTS" ' save locations '*location of the old user function* UserFunctionsLocation = "C:\Users\user.name\AppData\Roaming\Microsoft\AddIns\UserFunctions.xla" SaveLocation = "S:\MI\gre_cac\statement_feeds\waiting_to_upload\" Set WS = ActiveSheet Application.ScreenUpdating = False Workbooks.Open Filename:=UserFunctionsLocation 'clears any formats from the sheet With WS .Cells.ClearFormats End With 'standardises all fonts With WS.Cells.Font .Name = "Calibri" .Size = 10 .Bold = False End With With WS 'cleans all non_printable characters from the data (excluding date columns) & removes "'" & "," 'trims the insurer comments field to ensure it is a maximum of 500 characters lr = .Range("I" & Rows.Count).End(xlUp).Row Set Rng = Union(.Range("C2:AA" & lr), .Range("AD2:AO" & lr), .Range("AM2:AM" & lr)) For Each cl In Rng If cl.Column = 39 Then 'column AM gets Left() truncation as well cl = Left(WorksheetFunction.Trim(WorksheetFunction.Clean(cl.Value)), 500) cl = WorksheetFunction.Substitute(cl.Value, "'", "") cl = WorksheetFunction.Substitute(cl.Value, ",", "") Else cl = WorksheetFunction.Trim(WorksheetFunction.Clean(cl.Value)) cl = WorksheetFunction.Substitute(cl.Value, "'", "") cl = WorksheetFunction.Substitute(cl.Value, ",", "") End If Next cl 'format invoice_date, effective_date & spare_date to dd/mm/yyyy Union(.Range("AB1:AB" & lr), .Range("AC1:AC" & lr), .Range("AP1:AP" & lr)).NumberFormat = "dd/mm/yyyy" 'formats all numerical fields to "0.00" Union(.Range("AD2:AL" & lr), .Range("AO2:AO" & lr)).NumberFormat = "0.00" 'add the statement name Range("A2:A" & lr).FormulaR1C1 = StatementName 'add the organisation name Range("D2:D" & lr).FormulaR1C1 = Organisation 'adds the formula to generate the unique key (from the declared constant) Range("B2:B" & lr).Formula = csFORMULA Range("B2:B" & lr) = Range("B2:B" & lr).Value 'auto-fit all columns With WS .Columns.AutoFit End With 'checks that only date values as present in the invoice_date, effective_date & spare_date Set Rng = Union(.Range("AB2:AB" & lr), .Range("AC2:AC" & lr), .Range("AP2:AP" & lr)) For Each cl In Rng If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _ mssg = mssg & cl.Address(0, 0) & Space(4) Next cl End With 'If non-date values are found display a message box showing the cell locations If CBool(Len(mssg)) Then MsgBox (ErrorMessage & Chr(10) & Chr(10) & _ mssg & Chr(10) & Chr(10)), vbCritical, ErrorMessageTitle 'Otherwise display a message that the statement preparation is complete Else MsgBox CompleteMessage, , CompleteMessageTitle End If 'save location for the .csv SaveToDirectory = SaveLocation 'uses the set dateformat and save lovation WS.SaveAs SaveToDirectory & DateFormat & StatementName, xlCSV Set Rng = Nothing Set WS = Nothing Application.ScreenUpdating = True ActiveWorkbook.Close SaveChanges:=False End Sub Function AlphaNumericOnly(strSource As String) As String Dim i As Integer Dim strResult As String For i = 1 To Len(strSource) Select Case Asc(Mid(strSource, i, 1)) Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space strResult = strResult & Mid(strSource, i, 1) End Select Next AlphaNumericOnly = strResult End Function
通过注释工作：尝试在Select Case之前添加一个tempValue
Function AlphaNumericOnly(strSource As String) As String Dim i As Integer Dim strResult As String Dim tempValue As Integer For i = 1 To Len(strSource) tempValue = Asc(Mid(strSource, i, 1)) Select Case tempValue Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space strResult = strResult & Mid(strSource, i, 1) End Select Next AlphaNumericOnly = strResult End Function
使用正则expression式提供了一个更短效的解决scheme，然后检查每个字符：
Function AlphaNumericOnly(strIn) As String Dim objRegex As Object Set objRegex = CreateObject("vbscript.regexp") With objRegex .Global = True .ignorecase = True .Pattern = "[^\w]+" AlphaNumericOnly = .Replace(strIn, vbNullString) End With End Function