ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4655|回复: 30

[求助] 两个for循环和两个if套嵌,程序一直调试不过,急,请高手帮忙。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-12-26 11:35 | 显示全部楼层 |阅读模式
新手,一直在自学vba,这个程序是工作中需要,自己一直在学着写,由于是新手,程序里每用到一个功能,就会先写个小点的,学习、测试后再写到模块里。
[url=][/url]

模块中,单价转换是需要调试的代码,其他的是在写代码过程中学习和测试用的。
代码的说明已经写在附件的excel里。
完全新手,代码写了2个小时,修改调整花了将近10个小时,实在搞不定了。

代码截图.png

产品价格替换 - 源文件.rar

29.49 KB, 下载次数: 24

源文件

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-26 11:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
代码中的一个问题,即先for m循环,接着是if判断,如果if判断成立就往后运行,如果不成立,就下一个m循环,这个我一直感觉写的不对。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-26 11:50 | 显示全部楼层
另外,m步行设为2,我感觉也有问题,之前是1,步长设为1就会出现把新增的一行又给拆掉了,就把步长调为2了。

TA的精华主题

TA的得分主题

发表于 2018-12-27 00:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Sub danjiazhuanhuan()
  2.     Dim objDicUnitPrice As Object, objDicQuantity As Object
  3.     Dim shReplace As Worksheet, shSource As Worksheet
  4.     Dim lngRows As Long, arrTemp As Variant
  5.     Dim arrResult As Variant, lngIndex As Long
  6.     Dim lngRow As Long, lngCol As Long
  7.     Dim strKey As String, dblItem As Double
  8.     Dim dblCurUnitPrice As Double, dblCurQuantity As Double
  9.    
  10.    
  11.     Set shReplace = Sheets("替换内容")
  12.     Set shSource = Sheets("销售明细")
  13.     Set objDicUnitPrice = CreateObject("Scripting.Dictionary")
  14.     Set objDicQuantity = CreateObject("Scripting.Dictionary")
  15.    
  16.     lngRows = shReplace.Range("A" & Rows.Count).End(xlUp).Row
  17.     arrTemp = shReplace.Range("A2:D" & lngRows)
  18.     For lngRow = LBound(arrTemp) To UBound(arrTemp)
  19.         strKey = Format(arrTemp(lngRow, 1), "yyyymmdd") & arrTemp(lngRow, 2)
  20.         dblItem = arrTemp(lngRow, 4): objDicUnitPrice(strKey) = dblItem
  21.         dblItem = arrTemp(lngRow, 3): objDicQuantity(strKey) = dblItem
  22.     Next
  23.    
  24.     lngRows = shSource.Range("A" & Rows.Count).End(xlUp).Row
  25.     arrTemp = shSource.Range("A2:F" & lngRows)
  26.     ReDim arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To 1)
  27.    
  28.     For lngRow = LBound(arrTemp) To UBound(arrTemp)
  29.         strKey = Format(arrTemp(lngRow, 1), "yyyymmdd") & arrTemp(lngRow, 3)
  30.         If objDicUnitPrice.Exists(strKey) Then
  31.             dblCurUnitPrice = arrTemp(lngRow, 5)
  32.             dblCurQuantity = arrTemp(lngRow, 4)
  33.             If dblCurQuantity >= objDicQuantity(strKey) Then
  34.                 lngIndex = lngIndex + 1
  35.                 ReDim Preserve arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To lngIndex)
  36.                 For lngCol = LBound(arrTemp, 2) To UBound(arrTemp, 2)
  37.                     arrResult(lngCol, lngIndex) = arrTemp(lngRow, lngCol)
  38.                 Next
  39.                 arrResult(4, lngIndex) = dblCurQuantity - objDicQuantity(strKey)
  40.                 arrResult(6, lngIndex) = arrResult(4, lngIndex) * arrResult(5, lngIndex)
  41.                
  42.                 lngIndex = lngIndex + 1
  43.                 ReDim Preserve arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To lngIndex)
  44.                 For lngCol = LBound(arrTemp, 2) To UBound(arrTemp, 2)
  45.                     arrResult(lngCol, lngIndex) = arrTemp(lngRow, lngCol)
  46.                 Next
  47.                 arrResult(2, lngIndex) = "新客户"
  48.                 arrResult(4, lngIndex) = objDicQuantity(strKey)
  49.                 arrResult(5, lngIndex) = objDicUnitPrice(strKey)
  50.                 arrResult(6, lngIndex) = arrResult(4, lngIndex) * arrResult(5, lngIndex)
  51.                 objDicQuantity.Remove (strKey): objDicUnitPrice.Remove (strKey)
  52.             Else
  53.                 lngIndex = lngIndex + 1
  54.                 ReDim Preserve arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To lngIndex)
  55.                 For lngCol = LBound(arrTemp, 2) To UBound(arrTemp, 2)
  56.                     arrResult(lngCol, lngIndex) = arrTemp(lngRow, lngCol)
  57.                 Next
  58.                 arrResult(4, lngIndex) = 0
  59.                 arrResult(6, lngIndex) = 0
  60.                
  61.                 lngIndex = lngIndex + 1
  62.                 ReDim Preserve arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To lngIndex)
  63.                 For lngCol = LBound(arrTemp, 2) To UBound(arrTemp, 2)
  64.                     arrResult(lngCol, lngIndex) = arrTemp(lngRow, lngCol)
  65.                 Next
  66.                 arrResult(2, lngIndex) = "新客户"
  67.                 arrResult(4, lngIndex) = dblCurQuantity
  68.                 arrResult(5, lngIndex) = objDicUnitPrice(strKey)
  69.                 arrResult(6, lngIndex) = arrResult(4, lngIndex) * arrResult(5, lngIndex)
  70.                 objDicQuantity(strKey) = objDicQuantity(strKey) - dblCurQuantity
  71.             End If
  72.         Else
  73.             lngIndex = lngIndex + 1
  74.             ReDim Preserve arrResult(LBound(arrTemp, 2) To UBound(arrTemp, 2), 1 To lngIndex)
  75.             For lngCol = LBound(arrTemp, 2) To UBound(arrTemp, 2)
  76.                 arrResult(lngCol, lngIndex) = arrTemp(lngRow, lngCol)
  77.             Next
  78.         End If
  79.     Next
  80.    
  81.     arrResult = Application.WorksheetFunction.Transpose(arrResult)
  82.    
  83.     shSource.Range("A2").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
  84.    
  85. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-27 09:08 | 显示全部楼层
谢谢,我在论坛里给很多人发消息,希望有人能帮我,十分感谢你的回复。
程序运行没问题,虽然我看不太懂,我一行一行的学吧。
昨天夜里我换了个思路,又写了一遍代码,还是卡在if语句的退出上了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-27 09:09 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-27 09:47 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主的注释做的我好惭愧

TA的精华主题

TA的得分主题

发表于 2018-12-27 09:50 | 显示全部楼层
没有打开附件仔细看,但是第一个if完了之后不应该是Elseif吗?你怎么都是if

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-27 13:37 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-27 13:41 | 显示全部楼层
阳春白雪追书 发表于 2018-12-27 09:50
没有打开附件仔细看,但是第一个if完了之后不应该是Elseif吗?你怎么都是if

第一个if是判断日期是否与品名一致,第二个if是判断待转换单价的数量与原有的数量谁大谁小。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 19:31 , Processed in 0.039546 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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