[接龙...]部分程序代码注释，目录更新20051222

great · 发表于 2005-8-30 10:57

首先我要谢谢龙三老师。因为我是一个新手，很菜，龙三又很厉害，不管您年龄多大，在这我觉得我应该称您老师。可能我发得帖子不够明白，我重说一遍，一个表格里面有很多公式，也有连接，每次计算或改动后，都会产生一些表格是零，并且每次产生零得位置可能不同，我想每次计算后把整个表格是零的单元格把零换成空格，还请帮忙编一个宏来实现这个功能，如果您觉得用录制宏可以实现，麻烦您把怎么录制的具体步骤和结果写一下，如果是编的，也麻烦您注释一下，因为我太菜了，非常感谢。

Long_III · 发表于 2005-8-30 11:22

TO great：请单独发帖子求助！最好上传附件+说明！

我之前的回答是以为你表内都是数据，如果你有公式的话，替换是不可以替换公式的结果的。试试：工具》选项》试图》零值（前面的钩不要），不知可不可以?如果不能解决，还是请上传附件单独说明！

来生缘 · 发表于 2005-8-30 11:25

以下是引用great在2005-8-30 10:57:07的发言： 首先我要谢谢龙三老师。因为我是一个新手，很菜，龙三又很厉害，不管您年龄多大，在这我觉得我应该称您老师。可能我发得帖子不够明白，我重说一遍，一个表格里面有很多公式，也有连接，每次计算或改动后，都会产生一些表格是零，并且每次产生零得位置可能不同，我想每次计算后把整个表格是零的单元格把零换成空格，还请帮忙编一个宏来实现这个功能，如果您觉得用录制宏可以实现，麻烦您把怎么录制的具体步骤和结果写一下，如果是编的，也麻烦您注释一下，因为我太菜了，非常感谢。

工具——选项——视图——取消“零值”前面的勾

Long_III · 发表于 2005-8-30 13:12

24、写了几个自定义函数，关于一些数字的组合问题，有兴趣的朋友可以看看 OU0kqrgM.rar (21.34 KB, 下载次数: 238)

[此贴子已经被作者于2005-8-30 13:50:31编辑过]

great · 发表于 2005-8-30 17:02

谢谢龙三老师和来生缘，我自己再好好琢磨一下

Long_III · 发表于 2005-8-31 11:10

25、关于组合和数组应用的较好结合! 代码思路是，先列出所有的组合，然后对每一个组合的“和值”和列位置进行比较，符合条件就按条件确认其在数组中的位置，最后给单元格赋值！代码:

Private Sub CommandButton1_Click() Dim arr1() As String '最终需要生成的数组，定义成字符串型 Dim i%, j%, k%, t1%, t2%, t% '全部定义成整型 Dim arr As Variant Application.ScreenUpdating = False '关闭屏幕更新，防止闪屏及加快代码运行速度 arr = Range("b1:d1") '生成一个数据，记录b1、c1、d1的值 ReDim arr1(0 To 27, 1 To 3) As String '这个字符串数组，正好与B3:d30的大小一致，便于赋值

For i = 0 To 9 For j = i To 9 For k = j To 9 '做三个循环，排列出所有的组合 t1 = i + j + k '计算和值，这个值同时也是它在数组里的行位置 t = IIf(i = j, 1, 0) + IIf(i = k, 1, 0) + IIf(j = k, 1, 0) '计算相同的个数 t2 = Switch(t = 0, 3, t = 3, 1, t = 1, 2) '如果t等于0，说明三个都不相同，在数组中对应第三列 't＝3，说明三个数相同，对应数组的第一列，t＝1，说明两个数相同，对应第二列 If InStr(1, arr(1, t2), i) > 0 And InStr(1, arr(1, t2), j) > 0 _ And InStr(1, arr(1, t2), k) > 0 Then '判断i、j、k是否都在t2对应的数组arr里出现 arr1(t1, t2) = arr1(t1, t2) & IIf(arr1(t1, t2) = "", "", " ") & (i & j & k) '如果都出现就给最终要的数组赋值，中间以空格隔开 End If Next Next Next

Range("b3").Resize(28, 3) = arr1 '给单元格赋值，数组的大小正好与单元格大小一致 Range("b3").Activate '激活B3单元格 Application.ScreenUpdating = True End Sub

XtVJKZF0.rar (13.78 KB, 下载次数: 254)

Long_III · 发表于 2005-8-31 12:41

26、简单的生成目录代码！没有什么技巧，唯一需要了解的就是hyperlinks方法，在帮助里有详细的介绍【不好意思，原先的代码有一点点小问题，先修改了，欢迎大家测试2005-11-18】

Private Sub CommandButton1_Click() '建立一个超链接 Dim sht As Worksheet Dim rng As Range Columns(2).ClearContents '清除B列的内容 Set rng = [b2] '设置B2为目录的起始位置 For Each sht In Sheets '在每个表里循环 If sht.Name <> Me.Name Then '假如表的名称不等于当前表（因为代码在目录下，故Me就是表示当前表）名称 rng = sht.Name '给单元格赋值，等于表名 Me.Hyperlinks.Add rng, "", "'" & sht.Name & "'!A1" '在当前表建立一个超链接，链接到另外一个表的A1 sht.Hyperlinks.Add sht.[a1], "", Me.Name & "!" & rng.Address(0, 0) '在另外已表里的A1建立超连接，返回到当前表本单元格里 Set rng = rng.Offset(1, 0) '单元格向下移动一格 End If Next End Sub

Private Sub CommandButton2_Click() '删除链接内容 Dim sht As Worksheet Dim p As Hyperlink For Each sht In Sheets '在每个表里循环 For Each p In sht.Hyperlinks '在所有的链接里循环 sht.Range(p.Range.Address).Clear '删除链接单元格的内容和格式 'p.Delete '单纯删除超链接，不删内容，这句不能与上句同时使用 Next Next End Sub uCtdJXrw.rar (12.51 KB, 下载次数: 148)

[此贴子已经被作者于2005-11-18 10:30:17编辑过]

Long_III · 发表于 2005-8-31 15:15

27、另类筛选！利用一个数组取单元格的值，然后用新数组确定所有符合条件的值，最后赋值给单元格，代码：

Private Sub CommandButton1_Click() Dim arr '这个数组是取单元格的值 Dim arr1() '这是新数组 Dim irow%, i%, k%, k1% Dim s1, s2, s3, s4, s5 Application.ScreenUpdating = False Rows("10:10000").ClearContents '清除原有数据 s1 = [d4].Value s2 = [e4].Value s3 = [c3].Value s4 = [d3].Value s5 = [c4].Value '用变量来代替单元格的值，以免循环的时候多次调用单元格值，可以加快运行速度 irow = Sheet1.[a65536].End(xlUp).Row '总表里的最后一非空行 arr = Sheet1.Range("a5:z" & irow) '定义一个数组等于所有的数据 For i = 1 To irow - 4 '在这个数组里做一个循环，判断符合条件的总个数是多少个 If arr(i, 1) = s1 And arr(i, 2) = s2 And arr(i, 19) >= s3 And arr(i, 19) <= s4 Then k = k + 1 End If Next If k = 0 Then MsgBox "没有找到相应记录!": Exit Sub '如果没有找到就退出程序 ReDim arr1(1 To k, 1 To 11) '由于新的多维数组不能动态增加，所以用了上面一个过程确定它的最大维数，列为11 For i = 1 To irow - 4 '在原数组里循环，每行符合条件的数据，就赋值到新数据里 If arr(i, 1) = s1 And arr(i, 2) = s2 And arr(i, 19) >= s3 And arr(i, 19) <= s4 Then k1 = k1 + 1 arr1(k1, 1) = arr(i, 19) '根据实际需要，不同的列赋不同的值，这句表示新数组的第一列等于原数组19列对应的值 arr1(k1, 2) = arr(i, 7) '同上 arr1(k1, 3) = arr(i, 3) arr1(k1, 4) = arr(i, 11) arr1(k1, 5) = arr(i, 13) arr1(k1, 6) = arr(i, 22) arr1(k1, 7) = arr(i, 20) arr1(k1, 8) = arr(i, 23) arr1(k1, 9) = arr(i, 24) arr1(k1, 11) = s5 - arr1(k1, 1) arr1(k1, 10) = H_weekday(arr1(k1, 11)) '这里有个自定义函数，便于计算周数 End If Next [a10].Resize(k, 11) = arr1 '给单元格赋值 Application.ScreenUpdating = True End Sub

aPf8UMMK.rar (26.96 KB, 下载次数: 296)

modker · 发表于 2005-8-31 17:38

好棒!

chat163 · 发表于 2005-8-31 19:26

每次看到必定，学也学不完呀

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