上下及拷贝

djyang

上下及拷贝.rar (15.9 KB, 下载次数: 8)

2018-10-23 16:46 上传

点击文件名下载附件

1、跟据系数表中所列的同级的下级从数据库表查找，如果Y列数据为0的下级不拷贝到结果表里。拷贝的内容如下，一、数据库的A、B、D、W列拷贝到结果表里A、B、D、F列，
                二、结果表的C列采用系数表里A列。
                三、结果表的E列数值是系数表里母级的相同位置G列乘D列再乘（该级的Y列除该级母列的Y列）除结果表里的F列保留位数为系数表里的F列。
                四、结果表里的G列是本结果表里E列乘F列保留两位数。
2、如果系数表里E列不为0的情况下，该结果表里ABCDEG取数与上面一样，结果表的E列数值是*系数表里母级的相同位置E列乘D列保留位数为系数表里的F列。数据库里Y为0不执行及查不到数据库中的不执行。


下级说明：数据库表中1403.1的下级是1403.01.08、1403.01.09、1403.01.10。不是他下级是1403.02.001等，因为数据库表中所列的数前几位与系数中不同


上传的附件有误， 上下及拷贝2.zip (16.9 KB, 下载次数: 2)

2018-10-25 13:54 上传

点击文件名下载附件

djyang

老师帮一下忙

djyang

老师，帮我。。。

djyang

指导一下老师们

djyang

老师们写的不清楚吗

jsgj2023

结果表的E列数值是系数表里母级的相同位置G列乘D列再乘（该级的Y列除该级母列的Y列）除结果表里的F列保留位数为系数表里的F列

这句话里的[母级]是指什么?

djyang

1403.02.001
1403.02.014
1403.02.018
1403.02.019
1403.02.023它的母级是前五位在系数里B列

djyang

jsgj2023 发表于 2018-10-25 08:48
结果表的E列数值是系数表里母级的相同位置G列乘D列再乘（该级的Y列除该级母列的Y列）除结果表里的F列保留位 ...

上下及拷贝2.zip (16.9 KB, 下载次数: 3)

2018-10-25 13:50 上传

点击文件名下载附件

Neverback_dq

djyang 发表于 2018-10-25 13:50

Sub test()
Dim xsrr, sjkrr, jgrr()
xsrr = Sheets("系数").[a1].CurrentRegion
sjkrr = Sheets("数据库").[a1].CurrentRegion
r1 = UBound(xsrr): r2 = UBound(sjkrr)

For i = 2 To r1

    For j = 2 To r2
    If CStr(sjkrr(j, 1)) = CStr(xsrr(i, 2)) Then mjY25 = sjkrr(j, 25)   '查找到记录母级，并记录母级的Y列值。不保证顺序的情况下先全部查一遍
    Next

    For j = 2 To r2
    If (CStr(Left(sjkrr(j, 1), Len(xsrr(i, 2)))) = CStr(xsrr(i, 2))) And (CStr(sjkrr(j, 1)) <> CStr(xsrr(i, 2))) And (sjkrr(j, 25) <> 0) Then      '转换为字符进行比较，根据左边字符是否一致来判断是否为子级，排除相等的情况
     m = m + 1
    ReDim Preserve jgrr(1 To 7, 1 To m)
    jgrr(1, m) = sjkrr(j, 1)
    jgrr(2, m) = sjkrr(j, 2)
    jgrr(3, m) = xsrr(i, 1)
    jgrr(4, m) = sjkrr(j, 4)
    jgrr(6, m) = sjkrr(j, 23)
    If xsrr(i, 5) = 0 Then
    jgrr(5, m) = xsrr(i, 7) * xsrr(i, 4) * (sjkrr(j, 25) / mjY25) / jgrr(6, m)
    jgrr(5, m) = Round(jgrr(5, m), xsrr(i, 6))
    Else: jgrr(5, m) = xsrr(i, 5) * xsrr(i, 4): jgrr(5, m) = Round(jgrr(5, m), xsrr(i, 6))
    End If
    jgrr(7, m) = jgrr(5, m) * jgrr(6, m): jgrr(7, m) = Round(jgrr(7, m), 2)
    End If
    Next
Next
    Sheets("结果").Select
    Sheets("结果").[a1].CurrentRegion.Offset(1) = ""
    Sheets("结果").[a2].Resize(UBound(jgrr, 2), UBound(jgrr, 1)) = Application.WorksheetFunction.Transpose(jgrr)

End Sub