我希望此代码搜索名为((attribute value1,attribute value2..N)的列名称 如果该列包含分数值,则应将其转换为十进制。我正在使用这个宏(VBA) 代码正在运行,但它只转换一列(属性值1) 这将需要更多时间,因为我有多个列(属性值2 ... N)具有分数值。
请帮助我,我被击中了。
Sub deci()
Dim LR As Long
Dim Dash As Long
Dim Whole As Double
Dim lngDataColumn As Long
Dim pi
lngDataColumn = 4
Sheets("Sheet3").Select
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).row
For r = 2 To LR
s = Cells(r, lngDataColumn)
arr = Split(s, ",")
For i = LBound(arr) To UBound(arr)
Whole = 0
P = InStr(arr(i), " IN")
If P > 0 Then
Worksheet = (Left((arr(i)), P - 1))
Else
Worksheet = arr(i)
End If
Dash = InStr(Worksheet, "-")
If Dash > 0 Then
Whole = Frac(Left(Worksheet, Dash - 1))
Worksheet = Mid(Worksheet, Dash + 1)
End If
af = Right(arr(i), Len(arr(i)) - P + 1)
evfrac = Whole + Left(CStr(Evaluate(Worksheet)), 5)
' evfrac = Whole + Format(Evaluate(frac), "0.###")
ss = ss & evfrac & af & ", "
Next i
Cells(r, lngDataColumn) = Left(ss, Len(ss) - 2)
ss = ""
Next r
End Sub
Function Frac(ByVal X As String) As Double
Dim P As Integer, N As Double, Num As Double, Den As Double
X = Trim$(X)
P = InStr(X, "/")
If P = 0 Then
N = Val(X)
Else
Den = Val(Mid$(X, P + 1))
If Den = 0 Then Err.Raise 11 ' Divide by zero
X = Trim$(Left$(X, P - 1))
P = InStr(X, " ")
If P = 0 Then
Num = Val(X)
Else
Num = Val(Mid$(X, P + 1))
N = Val(Left$(X, P - 1))
End If
End If
If Den <> 0 Then
N = N + Num / Den
End If
Frac = N
End Function
答案 0 :(得分:0)
它只做一个专栏的原因是因为这正是你告诉它要对这部分代码做的事情:
lngDataColumn = 4
Sheets("Sheet3").Select
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).row
因为您将lngDataColumn
设置为固定数字,所以您的代码仅在第4列上执行。如果您想要将更多列作为循环执行,则需要以递增的相同方式增加此值{您r
循环中的{1}}。
例如:
for