这个代码能改一下吗？

青青的河边草 · 发表于 2019-10-11 14:58

以下这个代码能否改变一下：发现r列有5个以上单元格显黄色就另存。

Private Sub CommandButton15_Click()
Dim k As Range
Dim p As String
p = CreateObject("WScript.Shell").SpecialFolders("Desktop")
For Each k In ActiveSheet.[r8:r4000]
      If k.Interior.ColorIndex = 6 Then
         ActiveSheet.Copy
         ActiveWorkbook.SaveAs Filename:=p & "\保存" & Format(Now(), "yyyymmdd hmmss") & ".xls"
         ActiveWorkbook.Close False
         Exit For
      End If
      Application.DisplayAlerts = False
Next
End Sub

朱荣兴 · 发表于 2019-10-11 15:30

提示: 作者被禁止或删除内容自动屏蔽

青青的河边草 · 发表于 2019-10-11 19:39

本帖最后由青青的河边草于 2019-10-11 20:07 编辑

朱荣兴发表于 2019-10-11 15:30
Private Sub CommandButton15_Click() ''QQ:705664849
Dim k As Range
Dim p As String

提示Next沒有for，怎么办？

网海遨游 · 发表于 2019-10-11 19:44

青青的河边草发表于 2019-10-11 19:39
提示Next沒有for，怎么办？

把最后那个Next 删除试试

青青的河边草 · 发表于 2019-10-11 19:49

本帖最后由青青的河边草于 2019-10-11 20:11 编辑

网海遨游发表于 2019-10-11 19:44
把最后那个Next 删除试试

删除后，又无法另存文件

网海遨游 · 发表于 2019-10-11 20:26

这个意思？

Private Sub CommandButton1_Click()
Dim k As Range
Dim p As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
p = CreateObject("WScript.Shell").SpecialFolders("Desktop")
For Each k In ActiveSheet.[r8:r4000]
      If k.Interior.ColorIndex = 6 Then
         m = m + 1
      End If
If m >= 5 Then
         ActiveSheet.Copy
         ActiveWorkbook.SaveAs Filename:=p & "\保存" & Format(Now(), "yyyymmdd hmmss") & ".xlsx"
         ActiveWorkbook.Close False
         Exit Sub
      End If
Next k
   Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

网海遨游 · 发表于 2019-10-11 20:30

代码在审核，先上张图片

青青的河边草 · 发表于 2019-10-11 21:12

网海遨游发表于 2019-10-11 20:30
代码在审核，先上张图片

代入实际表中，运行提示没有for，删除for，代码无法循环执行。

xyxcc177 · 发表于 2019-10-12 02:57

网海遨游发表于 2019-10-11 19:44
把最后那个Next 删除试试

删了中间的Next

朱荣兴 · 发表于 2019-10-12 08:47

提示: 作者被禁止或删除内容自动屏蔽

		自动登录	找回密码
密码			免费注册

[求助] 这个代码能改一下吗？

最新热点 /1

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2019-10-11 15:30 \| 显示全部楼层 [广告] ★用Excel做企业管理系统，Excel服务器学习和下载★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2019-10-12 08:47 \| 显示全部楼层 [广告] ★ ChatOffice，能听会写的AI办公，包含百种Excel、Word、PPT工具，兼容WPS，百倍效率！★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报