ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 219|回复: 5

[求助] 改一下代码,数据保存到另一个工作簿

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-17 15:06 | 显示全部楼层 |阅读模式
说明:
目前新增商品功能没有问题,数据会保存到当前工作簿的Sheet2里

目的:
想让数据保存到同文件夹下的cs2.xlsm工作簿里,代码应如何改

先谢谢各位了
1123.png

cs.rar

27.89 KB, 下载次数: 4

TA的精华主题

TA的得分主题

发表于 2020-3-17 15:58 | 显示全部楼层
Private Sub okCmd_Click() '确定
    Dim jcRow As Long '基础信息行数
    If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Or TextBox4.Text = "" Then
        MsgBox "基础信息不能为空!, 请检查填写数据!"
        Exit Sub
    End If
    Dim pp As String, mc As String, gg As String, cd As String, yd As String, str As String
    pp = TextBox1.Text '品牌
    mc = TextBox2.Text '名称
    gg = TextBox3.Text '规格
    cd = TextBox4.Text '长度
    yd = TextBox5.Text '硬度
    str = pp & mc & gg & cd & yd
    Dim jcRange As Range
    For Each jcRange In Sheet2.Range("A3:A" & jcRow - 1)
        If str = jcRange & jcRange.Offset(0, 1) & jcRange.Offset(0, 2) & jcRange.Offset(0, 3) Then '检查是否有重复
            MsgBox "有重复数据, 请检查数据是否已存在!"
            Exit Sub
        End If
    Next
   ar = Array(TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text, TextBox5.Text)
   f = Dir(ThisWorkbook.Path & "\cs2.xlsm")
   If f <> "" Then
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
        jcRow = wb.Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
        wb.Worksheets("sheet2").Cells(jcRow, 1).Resize(1, 5) = ar
        wb.Close True
    TextBox1.Text = "" '品牌
    TextBox2.Text = "" '名称
    TextBox3.Text = "" '规格
    TextBox4.Text = "" '长度
    TextBox5.Text = "" '硬度
    MsgBox "数据已记录!"
        Unload newAdd
            End If
        Exit Sub
End Sub

TA的精华主题

TA的得分主题

发表于 2020-3-17 16:06 | 显示全部楼层
cs.rar (28.29 KB, 下载次数: 6)

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-17 16:27 | 显示全部楼层

此代码无法正常正常运行,无法检测另一个工作簿的重复项,就算删掉检查重复项代码,数据也没有保存到另一个工作簿

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-17 17:26 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-3-17 18:57 来自手机 | 显示全部楼层
全球悬赏 发表于 2020-3-17 16:27
此代码无法正常正常运行,无法检测另一个工作簿的重复项,就算删掉检查重复项代码,数据也没有保存到另一 ...

呵呵呵,你在1楼中说过要检测重复项吗?至于运行,不知道你说的是什么,我测试是可以正常的写入数据的。
顺便提一句,看你的回复,咋有点老师给学生作业写评语的感觉呢
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-5-28 15:00 , Processed in 1.088084 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表