24小时热门版块排行榜    

查看: 811  |  回复: 2
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

gemjzh

铜虫 (初入文坛)

[求助] VB 代码求更正! 已有1人参与

请教各位一下,我写了一段代码,是要生成随机数,并将相关信息逐行写入EXCEL中,但是运行时总是写入excel第一行(每次都是将第一行内容覆盖掉),代码如下,请帮忙修改一下,实现逐行写入(就是每一次运行不覆盖以前的内容,而是从空白的一行写入)。谢谢!

Private Sub Command1_Click()
  If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" _
  Or Trim(Combo1) = "" Or Trim(Combo2) = "" Then
    MsgBox "请输入完整信息", vbCritical, "提示"
    Text1.SetFocus
    Exit Sub
  End If
  b = Text2
  c = Text3
  If b <= c Then
    MsgBox "采样数应小于/等于总车数", vbCritical, "提示"
    Text2.SetFocus
    Exit Sub
  End If
  Max = b
  Min = 1
  Amount = c - 1
  ReDim a(Amount)
  Randomize
  For i = 0 To Amount
    a(i) = Int((Max - Min + 1) * Rnd + Min)
    For j = 0 To i
      If i <> j And a(i) = a(j) Then i = i - 1
    Next
  Next
  Text5 = Text1 & ";" & vbCrLf & Combo1.Text & "," & "共" & b & "个数字" & "," & _
  c & "个随机数" & ";" & vbCrLf & "随机数为:" & Join(a, "," & ";" & _
  vbCrLf & Combo2.Text & "," & "操作人员:" & Text4 & "。"

Static n As Integer
   FileName = "D:\随机抽号\历史记录.xls"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application"   
   If Err.Number <> 0 Then
     Set xlApp = CreateObject("Excel.Application"
     xlApp.Visible = False
   End If
   If Dir(FileName) = "" Then
     MsgBox FileName & "未找到!", vbCritical, "提示"
     Exit Sub
   End If
Set xlBook = xlApp.Workbooks.Open(FileName)
Set xlsheet = xlApp.Worksheets(1)
xlsheet.Activate  
With ActiveSheet.UsedRange
   n = .Cells(.Rows.Count, .Columns.Count).Row
End With
   xlsheet.Cells(n + 1, 1) = Now()
   xlsheet.Cells(n + 1, 2) = Text1
   xlsheet.Cells(n + 1, 3) = Combo1.Text
   xlsheet.Cells(n + 1, 4) = Text2
   xlsheet.Cells(n + 1, 5) = Text3
   xlsheet.Cells(n + 1, 6) = Join(a, ","
   xlsheet.Cells(n + 1, 7) = Combo2.Text
   xlsheet.Cells(n + 1, 8) = Text4
End Sub
回复此楼
哈哈哈哈哈
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

smitest

木虫 (小有名气)

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★
感谢参与,应助指数 +1
gemjzh: 金币+10, ★★★很有帮助 2018-11-02 09:38:30
With xlbook.ActiveSheet.UsedRange
3楼2018-10-31 19:54:02
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 3 个回答

gemjzh

铜虫 (初入文坛)

那几个表情是括号的右半边,就是“)”,发帖时自动出现的
哈哈哈哈哈
2楼2018-10-30 21:38:32
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[硕博家园] 哈尔滨工业大学韩晓军教授课题组招收2027年硕士推免生及博士研究生 +3 灯灯灯灯DDDD 2026-09-03 3/150 2026-09-03 21:22 by 科研皮皮猪
[考研] 售SCI一区文章,我:8.O.551.O.5.4,科目全,可伽急 +3 YLHlRHNwYkce 2026-09-02 8/400 2026-09-03 20:40 by jyNB2vrbdUpR
[公派出国] 售SCI一区T0P文章,我:8O.55.1.O.5.4,科目齐全,可+急 +3 YLHlRHNwYkce 2026-09-02 8/400 2026-09-03 20:31 by jyNB2vrbdUpR
[硕博家园] 售SCI一区文章,我:8.O.551.O.5.4,科目全,可伽急 +3 uFOAtb1CDngh 2026-09-02 9/450 2026-09-03 20:20 by jyNB2vrbdUpR
[考博] 找导师 +7 yuanjiabao 2026-08-29 8/400 2026-09-03 20:15 by yinnelly
[公派出国] 售SCI-T0P文章,我:8O.5.5.1.O.54,科目齐全,可+急 +4 ero8OE6tv9cu 2026-09-02 5/250 2026-09-03 20:09 by jyNB2vrbdUpR
[教师之家] 售SCI一区T0P文章,我:8.O55.1.O.54,科目全,可十急 +4 ero8OE6tv9cu 2026-09-02 9/450 2026-09-03 20:07 by jyNB2vrbdUpR
[基金申请] 面上没中,邀请各位路过的虫友分析一下分数 +3 jackleilei 2026-09-03 3/150 2026-09-03 19:13 by god_tian
[找工作] 售SCI一区T0P文章,我:8O.55.1.O.54,科目全,可伽急 +4 YLHlRHNwYkce 2026-09-02 11/550 2026-09-03 18:42 by jyNB2vrbdUpR
[硕博家园] 售SCI一区文章,我:8.O.551.O.5.4,科目全,可伽急 +3 rFEsUBKXRll0 2026-09-02 6/300 2026-09-03 16:49 by T0rGB46095mJ
[考研] 售SCI一区T0P文章,我:8O.55.1.O.5.4,科目齐全,可+急 +3 ero8OE6tv9cu 2026-09-02 10/500 2026-09-03 16:27 by T0rGB46095mJ
[基金申请] 国社科又开始会评了,不知道这次命运如何 +10 雨打竹帘 2026-08-30 14/700 2026-09-03 13:17 by qsd10086
[基金申请] 麻烦专家们看看评委们的意见(F口面上) +8 gdd2018 2026-08-28 13/650 2026-09-03 06:22 by 羽毛枫f
[基金申请] 要骂人了,新模版改版就是要淡化问题凝练这种虚的东西,结果有个评委还在说凝练得不够 +9 瞬息宇宙 2026-08-31 17/850 2026-09-02 14:04 by anjeeshine
[基金申请] 面上函评意见出来了,像什么等级? 20+4 Tsingking1 2026-08-27 17/850 2026-09-01 19:51 by 超级无敌华子
[基金申请] 面上意见出来了 +12 黄鸟于飞Chao 2026-08-29 23/1150 2026-08-31 18:57 by 黄鸟于飞Chao
[基金申请] 能否申诉? +7 echo8914667 2026-08-30 8/400 2026-08-31 17:00 by yihongxu
[基金申请] 中青基了要发朋友圈吗? +7 349506619 2026-08-28 7/350 2026-08-31 13:39 by 冼亮淀粉酶
[基金申请] 我就是申请一个面上项目而已,这评审意见是按照杰青的条件评的吧? +6 gouxfjh 2026-08-28 11/550 2026-08-30 07:57 by gouxfjh
[基金申请] 国自然评审意见 +13 wangmingqi 2026-08-28 19/950 2026-08-29 10:22 by Poppy1104
信息提示
请填处理意见