VBA 代码更改为 64 位。宏观因素销售不起作用
Posted
技术标签:
【中文标题】VBA 代码更改为 64 位。宏观因素销售不起作用【英文标题】:VBA code change to 64 bit. Macro to factor sales not working 【发布时间】:2018-02-27 05:19:15 【问题描述】:我继承了一个非常有用的宏,现在它在我们的新 64 位机器上不起作用 - 我已经修改了前面的 PtrSafe 代码,它似乎可以工作,但现在我在下面的宏上遇到了错误,我使用了所有时间。该宏通过将突出显示的单元格值修改为新输入数字的值来工作:该错误似乎突出显示了第一个 = Mid 代码,但它也以黄色突出显示了第一行。
(公共函数 ConcatAll(rngCells As Range, Optional pstrSep$ = "") As String)
任何帮助都会很棒。
Option Explicit
Public Function ConcatAll(rngCells As Range, Optional pstrSep$ = "") As String
'Concatenates the text values in the specified range
'Useful when coverting weeks to months
Dim c As Range
ConcatAll = ""
For Each c In rngCells
If c.Value <> "" Then
ConcatAll = ConcatAll & pstrSep & c.Value
End If
Next
ConcatAll = Mid(ConcatAll, Len(pstrSep) + 1)
End Function
Public Function ConcatUnique(rngCells As Range, Optional pstrSep$ = "") As String
'Concatenates the text values in the specified range, only if the value has not been concatenated already
'Useful when coverting weeks to months
Dim c As Range, strConcat$
strConcat = ""
For Each c In rngCells
If c.Value <> "" Then
If InStr(1, strConcat, c.Value) = 0 Then
strConcat = strConcat & pstrSep & c.Value
End If
End If
Next
ConcatUnique = Mid(strConcat, Len(pstrSep) + 1)
End Function
Public Function RPad(pstrSubj$, pintLen%, Optional pstrPad$ = " ") As String
'Pads out the right hand end of a given string with another character
If Len(pstrSubj) >= pintLen Then
RPad = pstrSubj
Else
Dim irpt%, strRes$
strRes = pstrSubj
Do Until Len(strRes & pstrPad) > pintLen
strRes = strRes & pstrPad
Loop
If Len(strRes) < pintLen Then
strRes = strRes & Left(pstrPad, pintLen - Len(strRes))
End If
RPad = strRes
End If
End Function
Public Function LPad(pstrSubj$, pintLen%, Optional pstrLPad$ = " ") As String
'Pads out the left hand end of a given string with another character
If Len(pstrSubj) >= pintLen Then
LPad = pstrSubj
Else
Dim irpt%, strRes$
strRes = pstrSubj
Do Until Len(strRes & pstrLPad) > pintLen
strRes = pstrLPad & strRes
Loop
If Len(strRes) < pintLen Then
strRes = Left(pstrLPad, pintLen - Len(strRes)) & strRes
End If
LPad = strRes
End If
End Function
Public Function ConcatIf(rngCells As Range, psCond$, Optional pstrSep$ = "", Optional prngVals As Range) As String
'Concatenates the text values in the specified range if the condition is satisfied
'Useful when coverting weeks to months
ConcatIf = ""
Dim rngVals As Range
If Not (prngVals Is Nothing) Then
If RngShapeEq(rngCells, prngVals) = True Then
Set rngVals = prngVals
Else
'Ranges do not equal - return blank
ConcatIf = "#Error"
Exit Function
End If
Else
Set rngVals = rngCells
End If
Dim iCell%, c As Range
iCell = 1
For Each c In rngCells
If IsError(c) Then
ConcatIf = "Error in cell " & c.Address
Exit Function
ElseIf IsError(rngVals.Cells(iCell)) Then
ConcatIf = "Error in cell " & rngVals.Cells(iCell).Address
Exit Function
Else
If Application.CountIf(c, psCond) > 0 Then
ConcatIf = ConcatIf & pstrSep & rngVals.Cells(iCell).Value
End If
End If
iCell = iCell + 1
Next
ConcatIf = Mid(ConcatIf, Len(pstrSep) + 1)
End Function
Private Function RngShapeEq(prng1 As Range, prng2 As Range) As Boolean
'Determines if the range shapes are equal
RngShapeEq = False
If prng1.Rows.Count = prng2.Rows.Count Then
If prng1.Columns.Count = prng2.Columns.Count Then
RngShapeEq = True
End If
End If
End Function
Public Function LTrim(pText$, Optional pTrimCh$ = " ") As String
'Trims the left end of the string with pTrimCh
Dim intTrimChLen%
intTrimChLen = Len(pTrimCh)
LTrim = pText
Do While Left(LTrim, intTrimChLen) = pTrimCh
LTrim = Mid(LTrim, intTrimChLen + 1)
Loop
End Function
Public Function RTrim(pText$, Optional pTrimCh$ = " ") As String
'Trims the right end of the string with pTrimCh
Dim intTrimChLen%
intTrimChLen = Len(pTrimCh)
RTrim = pText
Do While Right(RTrim, intTrimChLen) = pTrimCh
RTrim = Left(RTrim, Len(RTrim) - intTrimChLen)
Loop
End Function
【问题讨论】:
试试Public Function ConcatAll(rngCells As Range, Optional pstrSep as String = "") As String
您收到的错误信息是什么?
危险,危险威尔罗宾逊。为什么要定义 RTrim 和 LTrim?为什么要在赋值运算符的右侧使用函数名称?
VBA 中的 PtrSafe?您在此处的所有构造均未设计为在本机 64 位中运行(即不需要 PtrSafe)。
感谢 BruceWayne 和 AJD - 我添加了字符串并删除了一些似乎有效的旧代码。我在这方面完全是新手,并且如前所述,宏是很久以前继承和构建的。如果有人能解决这个问题,我还有另一个会引起我的问题吗?它的功能是将二维表转换为新工作表上的一维表。对于将日期作为列标题的表很有用。从选择的第一列的第一个左边的单元格开始。
【参考方案1】:
我看到的直接问题是:
Public Function ConcatAll(rngCells As Range, Optional pstrSep$ = "") As String
'Concatenates the text values in the specified range
'Useful when coverting weeks to months
Dim c As Range
ConcatAll = ""
For Each c In rngCells
If c.Value <> "" Then
ConcatAll = ConcatAll & pstrSep & c.Value ' *** Problem Here
End If
Next
ConcatAll = Mid(ConcatAll, Len(pstrSep) + 1) ' Problem Here
End Function
右侧对ConcatAll
的调用期望递归调用函数。 VBA IDE 会将其识别为格式错误的代码并将停止,这也解释了为什么它以黄色突出显示该行。使用一个临时变量,然后在 Function 的末尾赋值给 ConcatAll。
检查所有剩余的代码,因为您自始至终都重复了这个错误。
此外,为什么要在解释代码中重新定义本机 RTrim
和 LTrim
函数? VBA 不太适合重载。至少给它们一些其他名称以表明它们是自定义函数。
在LPad
中,您声明了irpt
,但您没有使用它。
你声明了很多整数。在这个时代,至少使用Long
!或者,如果您真的认为空间是个问题,您可以使用Short
。
【讨论】:
以上是关于VBA 代码更改为 64 位。宏观因素销售不起作用的主要内容,如果未能解决你的问题,请参考以下文章