设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 帮忙修改代码
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2992|回复: 8

[已解决]帮忙修改代码

[复制链接]
发表于 2014-11-18 09:16 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
I列是一个存货名称时，代码货出错，如何修改代码，谢谢！
最佳答案
月排行榜 / 总排行榜
qh8600
2014-11-19 16:22
雄鹰2013 发表于 2014-11-19 16:03
是I列一个品名也不写
  1. Sub demo()
  2.     If Cells(Rows.Count, 9).End(3).Row < 2 Then Exit Sub
  3.     Dim arr, brr, re(), i, x, n, m
  4.     arr = Range("a2:b" & Cells(Rows.Count, 1).End(3).Row).Value
  5.     brr = Range("i1:i" & Cells(Rows.Count, 9).End(3).Row).Value
  6.     ReDim re(1 To UBound(arr), 1 To 2)
  7.     For i = 1 To UBound(arr)
  8.     n = 0
  9.         For x = 2 To UBound(brr)
  10.             If arr(i, 1) = brr(x, 1) Then n = n + 1
  11.         Next
  12.         If n = 0 Then
  13.             m = m + 1
  14.             re(m, 1) = arr(i, 1)
  15.             re(m, 2) = arr(i, 2)
  16.         End If
  17.     Next
  18.     Range("e2:e65536").ClearContents
  19.     Range("E2").Resize(m, 2) = re
  20. End Sub
复制代码
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
 楼主| 发表于 2014-11-18 09:17 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
附件如下

坯件编码.rar

10.13 KB, 下载次数: 12
回复

使用道具 举报

zyouong
发表于 2014-11-18 09:59 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
模拟结果好象不对，A列为B的在EF列中怎么没有呢？
回复

使用道具 举报

qh8600
发表于 2014-11-18 10:00 | 显示全部楼层
雄鹰2013 发表于 2014-11-18 09:17
附件如下
  1. Sub demo()
  2.     Dim arr, brr, re(), i, x, n, m
  3.     arr = Range("a2:b" & Cells(Rows.Count, 1).End(3).Row).Value
  4.     brr = Range("i1:i" & Cells(Rows.Count, 9).End(3).Row).Value
  5.     ReDim re(1 To UBound(arr), 1 To 2)
  6.     For i = 1 To UBound(arr)
  7.         n = 0
  8.         For x = 2 To UBound(brr)
  9.             If arr(i, 1) = brr(x, 1) Then n = n + 1
  10.         Next
  11.         If n = 0 Then
  12.             m = m + 1
  13.             re(m, 1) = arr(i, 1)
  14.             re(m, 2) = arr(i, 2)
  15.         End If
  16.     Next
  17.     Range("e2:e65536").ClearContents
  18.     Range("E2").Resize(m, 2) = re
  19. End Sub
复制代码
楼主试试
回复

使用道具 举报

 楼主| 发表于 2014-11-18 14:37 | 显示全部楼层
qh8600 发表于 2014-11-18 10:00
楼主试试

但是如果A列一个品名都没有的话又会出现错误
回复

使用道具 举报

qh8600
发表于 2014-11-19 08:33 | 显示全部楼层
雄鹰2013 发表于 2014-11-18 14:37
但是如果A列一个品名都没有的话又会出现错误

我这里不报错啊
回复

使用道具 举报

 楼主| 发表于 2014-11-19 16:03 | 显示全部楼层
qh8600 发表于 2014-11-19 08:33
我这里不报错啊

是I列一个品名也不写
回复

使用道具 举报

qh8600
发表于 2014-11-19 16:22 | 显示全部楼层    本楼为最佳答案   
雄鹰2013 发表于 2014-11-19 16:03
是I列一个品名也不写
  1. Sub demo()
  2.     If Cells(Rows.Count, 9).End(3).Row < 2 Then Exit Sub
  3.     Dim arr, brr, re(), i, x, n, m
  4.     arr = Range("a2:b" & Cells(Rows.Count, 1).End(3).Row).Value
  5.     brr = Range("i1:i" & Cells(Rows.Count, 9).End(3).Row).Value
  6.     ReDim re(1 To UBound(arr), 1 To 2)
  7.     For i = 1 To UBound(arr)
  8.     n = 0
  9.         For x = 2 To UBound(brr)
  10.             If arr(i, 1) = brr(x, 1) Then n = n + 1
  11.         Next
  12.         If n = 0 Then
  13.             m = m + 1
  14.             re(m, 1) = arr(i, 1)
  15.             re(m, 2) = arr(i, 2)
  16.         End If
  17.     Next
  18.     Range("e2:e65536").ClearContents
  19.     Range("E2").Resize(m, 2) = re
  20. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-11-20 11:09 | 显示全部楼层
qh8600 发表于 2014-11-19 16:22

I列不写品名表示一个也不删除，E列显示的应该是全部的数据吧而不是没有数据
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-15 18:04 , Processed in 0.498838 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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