[已解决]求教一个较复杂的计算

whhy2009

在日常工作中，手工按公式太繁琐且格式或行不固定，现求教如何把一列中的几个百分比（中央75%省8%地市8.5%县区8.5%）乘以某列分别放入其他列中。具体内容详见上传表格，谢谢！！！ j1UH0mH1.rar (3.46 KB, 下载次数: 12)

2010-12-5 14:24 上传

点击文件名下载附件
求教一个较复杂的计算

最佳答案

月排行榜 / 总排行榜

liuguansky

2010-12-6 11:31

数据类型申明有误，把CLNG改成CSNG

Sub justtest()
    Dim arr, i&, k&, arrt, arrre()
    k = Cells(Rows.Count, 2).End(3).Row - 1
    arr = Cells(2, 2).Resize(k, 8)
    arrt = Split("中央 省 市 区")
    ReDim arrre(1 To k, 1 To 4)
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> "" Then
            For j = 1 To 4
                If InStr(1, arr(i, 1), arrt(j - 1)) > 0 Then
                    arrre(i, j) = Round(arr(i, 8) * CSng(Split(Split(arr(i, 1), arrt(j - 1))(1), "%")(0)) / 100, 2)
                    Else: arrre(i, j) = 0
                End If
            Next j
        End If
    Next i
    Range("j2:m" & Rows.Count).ClearContents
    Cells(2, "j").Resize(k, 4) = arrre
End Sub

跳转到最佳答案楼层

Zipall

B25要怎么处理？

Zipall

J2输入公式

=$I2*IF(ISERR(FIND(RIGHT(J$1),$B2)),,MID($B2,FIND(RIGHT(J$1),$B2)+1,FIND("%",$B2,FIND(RIGHT(J$1),$B2)+1)-FIND(RIGHT(J$1),$B2)))

向右向下填充

VBA没必要。

liuguansky

Sub justtest()
    Dim arr, i&, k&, arrt, arrre()
    k = Cells(Rows.Count, 2).End(3).Row - 1
    arr = Cells(2, 2).Resize(k, 8)
    arrt = Split("中央 省 市 区")
    ReDim arrre(1 To k, 1 To 4)
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> "" Then
            For j = 1 To 4
                If InStr(1, arr(i, 1), arrt(j - 1)) > 0 Then
                    arrre(i, j) = Round(arr(i, 8) * CLng(Split(Split(arr(i, 1), arrt(j - 1))(1), "%")(0)) / 100, 2)
                    Else: arrre(i, j) = 0
                End If
            Next j
        End If
    Next i
    Range("j2:m" & Rows.Count).ClearContents
    Cells(2, "j").Resize(k, 4) = arrre
End Sub

6cRVfVPc.rar (10.35 KB, 下载次数: 2)

2010-12-5 17:18 上传

点击文件名下载附件
求教一个较复杂的计算

liuguansky

数据类型申明有误，把CLNG改成CSNG

Sub justtest()
    Dim arr, i&, k&, arrt, arrre()
    k = Cells(Rows.Count, 2).End(3).Row - 1
    arr = Cells(2, 2).Resize(k, 8)
    arrt = Split("中央 省 市 区")
    ReDim arrre(1 To k, 1 To 4)
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> "" Then
            For j = 1 To 4
                If InStr(1, arr(i, 1), arrt(j - 1)) > 0 Then
                    arrre(i, j) = Round(arr(i, 8) * CSng(Split(Split(arr(i, 1), arrt(j - 1))(1), "%")(0)) / 100, 2)
                    Else: arrre(i, j) = 0
                End If
            Next j
        End If
    Next i
    Range("j2:m" & Rows.Count).ClearContents
    Cells(2, "j").Resize(k, 4) = arrre
End Sub

whhy2009

谢谢

liuguansky

的热心解答。同时，也很感谢Zipall的热心解答（因主要用VBA，公式很不错很实用，因只能评一个最佳，对不住你，没给了）。希望今后还能得到二位的指教，再一次感谢二位！！！