VBA入门指南——献给在这里得到帮助但看不懂代码的朋友（已建电梯）

yagi2008

【2009.2.5】由于需要修改一个软件项目，今日暂停更新，明日继续~~~

jury2003

就是想知道一下这些关键的东西！！

yagi2008

原帖由 yd0209 于 2009-2-5 21:55 发表
代码如何能写入新EXCELB表？
有个限制使用天数的代码：
ub Auto_Open()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsoluteP ...

【工具】》【选项】》【安全性】选项卡，在“个人信息选项”一栏下的“保存时从文件属性中删除个人信息”前的勾去掉！！如下图：

chqf

太好了，刚看就被吸引住了！

xcbilly

报到，等着更新。

wbs1974

太精彩了，我还在想买一本VBA方面的书，现在一看yagi2008老师的讲座，我想是没有这个必要了！！

精-彩

yagi2008

　　这两天真的很忙，当你被周围的同事、朋友当做“高手”的时候，你就一定会变得这样！其实，我所提供给他们的帮助都是非常简单的应用。
　　停了一天，正好给大家休息一下，前面的例子还记得吗？我看到好多朋友都提出了自己的疑问，我也在帖子里都一一作答了，这使我看到了来自越来越多的朋友的关心和期望，大家的认真也让我非常感动，这也是我坚持下去的最大的动力！今天我们要进入一个新的例子，其实这个例子也来源于这里前期的一个朋友发帖的问题。实例如下： 批量数据处理.rar (25.07 KB, 下载次数: 3446)

2009-2-6 23:55 上传

点击文件名下载附件

　　这个实例的目的是进行数据的批量处理，然后将结果存放在指定位置，同时由于数据较多，处理比较慢，因此需要对处理过程进行跟踪和告知用户处理进度。那么具体要进行什么样的数据处理呢？根据要求，题目给出了从A1到AF30单元格区域的大量数据，共计960个数据。要求对这些数据进行分类，将出现次数依次为1次、2次、3次......的数据放在同一列中归类，并统计每一类的数据个数。
　　这个题目看似比较复杂，其实有很多方法可以实现，而采用VBA的解决方案，可以更直观、更快捷的进行处理。我们经常讲在实际开始做事前先考虑一下方法，往往会找到最好的途径，从而起到事半功倍的效果。那么现在请你先考虑下实现这个要求的思路吧。这次，我们就用一种最简单、最易于理解、也最不经济的方法来实现，这里先讲一下思路：通过循环结构依次从A1到AF30开始逐个取数，每次取到一个数，首先统计下该数在整个A1到AF30区域内出现的次数；然后将该数与应该放置的列中已经存在的数据进行比较，以判断是否之前已经出现过该数，如果第一次出现，则记录该数，否则直接跳过，不再处理。同时，对各类数据的个数进行统计，实时修改统计单元格的数据，以达到展示处理进度的目的。
　　有了思路，我们就可以写出代码了，先将代码贴出来给大家看看，代码如下：
Private Sub CommandButton1_Click()
Dim i, j, p, q, x, y, u As Integer
Dim tmpaddr As String
p = 34
q = 34
x = 34
y = 34
w = 0
Range("A34", "D1000").Clear
For i = 1 To Sheet2.Range("a1", "af30").Cells.Count
    tmpaddr = Sheet2.Range("a1", "af30").Cells(i).Address
    j = CountIf(Sheet2.Range("a1", "af30"), Sheet2.Range(tmpaddr).Value)
    Select Case j
    Case 1:
        Sheet2.Range("A" & CStr(p)).Value = Sheet2.Range(tmpaddr).Value
        p = p + 1
        Range("g34").Value = CStr(p - 34)
    Case 2:
        For u = 34 To q - 1
            If Sheet2.Range("B" & CStr(u)).Value = Sheet2.Range(tmpaddr).Value Then
                GoTo exit_q
            End If
        Next
        Sheet2.Range("B" & CStr(q)).Value = Sheet2.Range(tmpaddr).Value
        q = q + 1
        Range("h34").Value = CStr(q - 34)
exit_q:
    Case 3:
        For u = 34 To x - 1
            If Sheet2.Range("C" & CStr(u)).Value = Sheet2.Range(tmpaddr).Value Then
                GoTo exit_x
            End If
        Next
        Sheet2.Range("C" & CStr(x)).Value = Sheet2.Range(tmpaddr).Value
        x = x + 1
        Range("i34").Value = CStr(x - 34)
exit_x:
    Case Is > 3:
        For u = 34 To y - 1
            If Sheet2.Range("D" & CStr(u)).Value = Sheet2.Range(tmpaddr).Value Then
                GoTo exit_y
            End If
        Next
        Sheet2.Range("D" & CStr(y)).Value = Sheet2.Range(tmpaddr).Value
        y = y + 1
        Range("j34").Value = CStr(y - 34)
exit_y:
'    Case Else
'        w = w + 1
'        Range("k34").Value = CStr(w)
    End Select
Next
End Sub
Private Function CountIf(ByVal tmpR As Range, ByVal tmpN As String) As Integer
Dim a, b, c As Integer
b = 0
For a = 1 To tmpR.Cells.Count
    If tmpR.Cells(a).Value = tmpN Then
        b = b + 1
    End If
Next
CountIf = b
End Function
　　请大家通过前面讲解的知识自己先分析下代码，下次课程详细讲解代码编写方法和作用。

yagi2008

赶在１２点之前发出帖子，哎，真是不容易啊～～

gzky

版主辛苦了，从头到尾看完你的贴，你真的把我们带到VBA门口了，希望不要丢下我们，把上面的课题的换个按钮观赏，很精彩，盼下节详解。