sliang28 发表于 2015-4-19 11:02

练习题

本帖最后由 JLxiangwei 于 2015-4-25 10:14 编辑

皆さん：

小题一道，请笑纳！

附件在二楼

sliang28 发表于 2015-4-19 11:05

一楼传不了附件，就放二楼吧{:3912:}

郭郭嗯 发表于 2015-4-19 15:18

弟子不才，不会SQL:dizzy:

ys19840718 发表于 2015-4-19 15:25

本帖最后由 ys19840718 于 2015-4-20 11:38 编辑

SQL不会，先上无脑公式=LOOKUP(ROW(1:35),SUBTOTAL(9,OFFSET(C1,,,ROW(1:6)))+1,A2:A7)*{1,1,0}+(ROW(1:35)-LOOKUP(ROW(1:35),SUBTOTAL(9,OFFSET(C1,,,ROW(1:6)))+1,SUBTOTAL(9,OFFSET(C1,,,ROW(1:6)))+1))*{0,1,0}+LOOKUP(ROW(1:35),SUBTOTAL(9,OFFSET(C1,,,ROW(1:6)))+1,B2:B7)/LOOKUP(ROW(1:35),SUBTOTAL(9,OFFSET($C$1,,,ROW(1:6)))+1,C2:C7)*{0,0,1}VBASub test()

Dim arr
Dim dic As Object
Dim i As Long, j As Long
Dim t As Double

t = Timer
Set dic = CreateObject("Scripting.Dictionary")

With Worksheets("题目")
    arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(arr)
      For j = 1 To arr(i, 3)
            dic(arr(i, 1) & "|" & arr(i, 1) + j - 1 & "|" & arr(i, 2) / arr(i, 3)) = ""
      Next
    Next

    Erase arr
    arr = dic.keys
    .Range(.Cells(2, 6), .Cells(.Cells(.Rows.Count, 8).End(xlUp).Row, 8)).ClearContents

    Application.ScreenUpdating = False
    For i = 0 To UBound(arr)
      .Range("F" & i + 2).Resize(, 3) = VBA.Split(arr(i), "|")
    Next
    Application.ScreenUpdating = True
End With

Debug.Print Timer - t

End Sub

蝶·舞 发表于 2015-4-19 16:20

说真的，我看了三个小时都没看懂题目要求^:Q

Hsiao 发表于 2015-4-20 11:29

SQL不会，VBA答案，锁哥多多指教。

Excel学徒123 发表于 2015-4-20 11:40

本帖最后由 Excel学徒123 于 2015-4-20 11:42 编辑

Sub test()
    Dim arr, brr()
    Dim Ir As Integer, n As Byte
    Dim Icount As Integer
    Dim Ibr As Integer
    arr = Range("a1").CurrentRegion
    ReDim brr(1 To Application.WorksheetFunction.Sum(Range("c:c")), 1 To 3)
      For Ir = 2 To UBound(arr)
            For Icount = 1 To arr(Ir, 3)
                Ibr = Ibr + 1
                n = n + 1
                brr(Ibr, 1) = arr(Ir, 1)
                brr(Ibr, 2) = brr(Ibr, 1) + n - 1
                brr(Ibr, 3) = arr(Ir, 2) / arr(Ir, 3)
            Next
            n = 0
      Next
    .Resize(UBound(brr), 3) = brr
End Sub
交答案咯~~~~，请老师审查哦~~~~{:02:}

雪舞子 发表于 2015-4-20 12:27

vba 法:Sub test()
    Dim arr, brr(100, 1 To 3), i%, j%, n%
    arr = .CurrentRegion
    For i = 2 To UBound(arr)
      For j = 1 To arr(i, 3)
            n = n + 1
            brr(n, 1) = arr(i, 1)
            brr(n, 2) = arr(i, 1) + j + (arr(i, 3) <> 8) '为了跟示例一致,多加了一个判断
            brr(n, 3) = arr(i, 2) / arr(i, 3)
      Next
    Next
    brr(0, 1) = "预订日期"
    brr(0, 2) = "使用日期"
    brr(0, 3) = "金额"
    .Resize(n + 1, 3) = brr
    .CurrentRegion.Borders.LineStyle = xlContinuous
End Sub

MCQUEEN 发表于 2015-4-20 13:54

本帖最后由 MCQUEEN 于 2015-4-21 11:20 编辑


沐沐 发表于 2015-4-20 16:58

{:22:}只会函数SQL想不出来~先占个座
页: [1] 2
查看完整版本: 练习题