[已解决]能力有限 请大大们帮忙 数据依次自动保存

daxia403

各位大大帮忙看看在表1中是一个游戏的模拟程序  表2中a:k单元格是从表1中提取的数据 每次70行数据
问题是这样的我想每次模拟一靴的结果都依次自动保存在表2中每次有70组数据，每次结果和每次结果用
三行空格隔开 现在的问题是我每次模拟一靴上一次的结果就没了只有新的，只保存当次的结果，不知表达清楚没

最佳答案

月排行榜 / 总排行榜

lmze2000

2016-5-24 06:51

你看一下，是不是这种效果的。

Sub Dt()
    Dim Arr, Brr, Crr
    With Sheets("sheet1")
        Arr = .[h1:l141]
        Brr = .[ad1:ah141]
    End With
    ReDim Crr(1 To 70, 1 To 11)
    For i = 2 To 71
        d = (i - 1) * 2: s = (i - 1) * 2 + 1: js = js + 1
        Crr(js, 1) = Arr(d, 1)
        Crr(js, 2) = Brr(s, 4)
        Crr(js, 3) = Brr(s, 1)
        Crr(js, 4) = Brr(s, 2)
        Crr(js, 5) = Arr(d, 2)
        Crr(js, 6) = Arr(d, 3)
        Crr(js, 7) = Arr(s, 3)
        Crr(js, 8) = Arr(d, 4)
        Crr(js, 9) = Arr(d, 5)
        Crr(js, 10) = Arr(s, 5)
        Crr(js, 11) = Brr(s, 5)
    Next
    lrow = Sheets("sheet2").Cells(Rows.Count, 1).End(3).Row
    If lrow = 1 Then
        Sheets("sheet2").[a2].Resize(70, 11) = Crr
    Else
        Sheets("sheet2").[a1].Resize(70, 11).Offset(lrow + 3) = Crr
    End If
    With Sheets("sheet2")
        .Range("a1:k1").Copy
        .Cells(lrow + 3, 1).Resize(70, 11).PasteSpecial Paste:=xlPasteFormats
    End With
     Application.CutCopyMode = False
End Sub


12 .545.zip (69.51 KB, 下载次数: 13)

2016-5-24 06:50 上传

点击文件名下载附件

跳转到最佳答案楼层

金樽空对月

你原来的都是用公式实现的是吧，我试一下看看。

lmze2000

你看一下，是不是这种效果的。

Sub Dt()
    Dim Arr, Brr, Crr
    With Sheets("sheet1")
        Arr = .[h1:l141]
        Brr = .[ad1:ah141]
    End With
    ReDim Crr(1 To 70, 1 To 11)
    For i = 2 To 71
        d = (i - 1) * 2: s = (i - 1) * 2 + 1: js = js + 1
        Crr(js, 1) = Arr(d, 1)
        Crr(js, 2) = Brr(s, 4)
        Crr(js, 3) = Brr(s, 1)
        Crr(js, 4) = Brr(s, 2)
        Crr(js, 5) = Arr(d, 2)
        Crr(js, 6) = Arr(d, 3)
        Crr(js, 7) = Arr(s, 3)
        Crr(js, 8) = Arr(d, 4)
        Crr(js, 9) = Arr(d, 5)
        Crr(js, 10) = Arr(s, 5)
        Crr(js, 11) = Brr(s, 5)
    Next
    lrow = Sheets("sheet2").Cells(Rows.Count, 1).End(3).Row
    If lrow = 1 Then
        Sheets("sheet2").[a2].Resize(70, 11) = Crr
    Else
        Sheets("sheet2").[a1].Resize(70, 11).Offset(lrow + 3) = Crr
    End If
    With Sheets("sheet2")
        .Range("a1:k1").Copy
        .Cells(lrow + 3, 1).Resize(70, 11).PasteSpecial Paste:=xlPasteFormats
    End With
     Application.CutCopyMode = False
End Sub


12 .545.zip (69.51 KB, 下载次数: 13)

2016-5-24 06:50 上传

点击文件名下载附件

daxia403

问题解决了 谢谢大大  真心感谢！！！！！！！！

d346836673

顶