带你入门VBA系列之：不懂的代码快点贴过来

Robin_zrp

请问兰老师下面这段代码是什么意思？Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Names.Add Name:="Auto_Activate", RefersToR1C1:="=宏表1!R2C1"
End Sub

Robin_zrp

请问这段代码是什么意思  Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Names.Add Name:="Auto_Activate", RefersToR1C1:="=宏表1!R2C1"
End Sub

sagedemon

Private Sub CommandButton1_Click()
    Dim cn As New ADODB.Connection
    Dim fn As Variant
    Dim Filename As Variant
    Dim strTbl As String
    Dim Sql As String
    Dim irow As Integer
    Dim erow As Integer
    erow = ThisWorkbook.Sheets(1).Cells(65535, 1).End(xlUp).Row
     
    Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取多个文件", , MultiSelect:=True)
    If Not IsArray(Filename) Then Exit Sub
   
    For Each fn In Filename
        With cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Data Source=" & fn & ";Extended Properties=Excel 8.0;"
            .CursorLocation = adUseClient
            .Open
        End With
        For irow = 4 To erow
       
          Sql = "Select 报表值 FROM [Sheet1$] where 工作证号 = '" & Cells(irow, 1) & " '"
            
            
             Cells(irow, 4).CopyFromRecordset cn.Execute(Sql)这个语句的结果值是以列显示的，我想要结果以行显示，因为每个

值都是最多有31个结果，想把这个结果填在d4－AH4　d5-ah5 .......里，请问老师要怎样改一下呀？
            
               
        Next irow
        cn.Close
     Next
    Set cn = Nothing

End Sub

Long_III

QUOTE:

以下是引用gzxw在2007-1-21 15:05:20的发言：

Function dx(r1)
dx = Application.WorksheetFunction.VLookup(r1,arr("","";"吖","A";"八","B";"嚓","C";"咑","D";"鵽","E";"发","F";"猤","G";"铪","H";"夻","J";"咔","K";"垃","L";"嘸","M";"旀","N";"噢","O";"妑","P";"七","Q";"囕","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"),2)
End Function

可是在编写的时候,老是提醒: "编译错误,缺少列表分隔符"

我主要的意思是请教老师,在Excel的VBA中怎样设置常量数量,能否以此来详细说明一下.

 

二维数组的使用不对，上面的代码我修改了一下，虽然麻烦些，但是只能这样使用

Sub dx()
    Dim r1 As String, i%, iMax%, x
    Dim arr()
    Dim arr1, arr2

    r1 = "名"
    arr1 = Array("", "吖", "八", "嚓", "咑", "鵽", "发", "猤", "铪", "夻", "咔", "垃", "嘸", "旀", "噢", "妑", "七", "囕", "仨", "他", "屲", "夕", "丫", "帀")
    arr2 = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "W", "X", "Y", "Z")
    iMax = UBound(arr1)
    ReDim arr(0 To iMax, 0 To 1) '重新定义一个二维数组
    For i = 0 To iMax
        arr(i, 0) = arr1(i)
        arr(i, 1) = arr2(i)
    Next

    x = Application.WorksheetFunction.VLookup(r1, arr, 2) '这里的vlookup只能接受上面那种类型的二维数组
    Debug.Print r1, x
End Sub
其实也可以直接用公式，然后取消公式转变成值，不过这样就不能用自定义函数了

增加一个Match的示例，我想是一个效果

Sub dx()
    Dim r1 As String, i%, iMax%, x
    Dim arr1, arr2

    r1 = "名"
    arr1 = Array("", "吖", "八", "嚓", "咑", "鵽", "发", "猤", "铪", "夻", "咔", "垃", "嘸", "旀", "噢", "妑", "七", "囕", "仨", "他", "屲", "夕", "丫", "帀")
    arr2 = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "W", "X", "Y", "Z")

    x = arr2(Application.WorksheetFunction.Match(r1, arr1, 1) - 1) '用match函数的近似查找，好像也可以哦，请测试
    Debug.Print r1, x
End Sub

[此贴子已经被作者于2007-1-24 10:28:34编辑过]

Long_III

QUOTE:

以下是引用andysky在2007-1-20 11:45:37的发言：

Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate

以上代码重算Columns("A:C").其它工作表内容不会重算?

也就是说这种方式比F9或者SHIFT+F9更有灵活性,书上说F9无法针对工作表某个区域是不精确的说法?

兄台可以试验一下，理论上应该是这样的

可能有些版本不支持吧，我很少用，也没测试过

Long_III

QUOTE:

以下是引用女强人_1234在2007-1-20 12:48:32的发言：

Sub save1()
    Dim i As Integer, j As Integer, k As Integer

    closefilename = Application.GetSaveAsFilename(fileFilter:="TEXT 文件(*.txt),*.txt,所有文件(*.*),*.*")
    '打开选择文件对话框，文件类型是文本，closefilename记录的是这个文本的路径名称
    If closefilename <> False Then  '如果选择了文本，
        Open closefilename For Output As #1    '以Output模块打开这个text文件，类似excel的打开，不过记事本文件打开之后是不显示出来的
        For j = 1 To 4
            For i = 1 To 5
                Write #1, Sheets("Sheet2").Cells(i, j):    '把单元格里的内容写入到文本里去，这里的#1是打开这个文本时的临时名称
            Next i
        Next j

        Close #1    '关闭打开的文本文件
    End If
End Sub

建议搜索Open的帮助，关于文本文件的，里面很详细

[此贴子已经被作者于2007-1-24 10:35:05编辑过]

Long_III

QUOTE:

以下是引用303hd在2007-1-21 10:21:30的发言：

谢谢兰老师，但我还有一句不明白(红色这句): 

Sub Me_Micro()
    Dim t_Str$
    Dim i%
    Dim Bh() As String
    For n = 2 To [B65536].End(xlUp).Row
        Bh = Split(Cells(n, 2), "编号")
        If UBound(Bh) > 0 Then
            For i = 1 To UBound(Bh)
                t_Str = t_Str & i & Split(Cells(n, 2), "编号")(i)

                debug.print t_str,i,Split(Cells(n, 2), "编号")(i)
            Next
            Cells(n, 2) = t_Str
        End If
    Next
End Sub

请百忙中给个解释，

如果split理解之后，在代码里加一句，运行之后，按CTRL＋G，在立即窗口里看看每次i变化的时候，字符串是怎么变化的

Long_III

QUOTE:

以下是引用Robin_zrp在2007-1-23 16:28:21的发言：
请问这段代码是什么意思  Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Names.Add Name:="Auto_Activate", RefersToR1C1:="=宏表1!R2C1"
End Sub

是一个工作表增加事件，代码会在你新增一个工作表的时候运行

Sh.Names.Add Name:="Auto_Activate", RefersToR1C1:="=宏表1!R2C1"

是在你新增的工作表下面再增加一个名称Auto_Activate，这个名称的对应位置为=宏表1!$A$2

爱歌学习

QUOTE:

以下是引用3rdfang在2007-1-17 16:00:30的发言：

请帮忙：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$12" Or Target.Address = "$B$12" Or Target.Address = "$C$12" Then
        Range("a17:F65536").Clear
        Set X = CreateObject("ADODB.Connection")
        X.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.FullName（指该ＥＸＣＥＬ文件？）－－是的
        Sql = "select * from [sheet1$A3:F9]"
        If [a12] <> "" Then
            Sql = Sql & " where f1=" & [a12] & ""
            If [b12] <> "" Then Sql = Sql & " and f2=" & [b12] & ""
            If [c12] <> "" Then Sql = Sql & " and f3='" & [c12] & "'"（为什么F2与F3不一样？区别在哪里？F1/F2/F3是不是随便定义的？）－－F1、F2、F3表示第1列、第2列、第3列
        Else
            If [b12] <> "" Then
                Sql = Sql & " where f2=" & [b12] & ""
                If [c12] <> "" Then Sql = Sql & " and f3='" & [c12] & "'"
            Else
                If [c12] <> "" Then
                    Sql = Sql & " where f3='" & [c12] & "'"
                End If
            End If
        End If
        Set yy = X.Execute(Sql)这句话是什么意思？－－执行Sql语句，也可以和下一句合成一句：
        Sheet1.[a17].CopyFromRecordset yy          Sheet1.[a17].CopyFromRecordset X.Execute(Sql)          
        Set yy = Nothing: Set X = Nothing
    End If
End Sub

dxy27

QUOTE:

以下是引用dxy27在2007-1-22 9:42:29的发言：

Sub FTY()

Application.ScreenUpdating = False
On Error Resume Next
Dim arr, arr2, i As Long, j As Long, x As New Collection
arr = Sheets("Detail").UsedRange
arr2 = Sheets("FTY & LSP Pick List").[a2].Resize([a1].End(xlDown).Row - 1, 1)
For i = 1 To UBound(arr2)
x.Add i, CStr(arr2(i, 1))
Next
ReDim arr2(1 To UBound(arr2), 1 To 8)

For i = 2 To UBound(arr)

If Len(arr(i, 23)) > 0 Then
arr2(x(CStr(arr(i, 21))), 1) = arr2(x(CStr(arr(i, 21))), 1) + 1
arr2(x(CStr(arr(i, 21))), 3) = arr2(x(CStr(arr(i, 21))), 3) + arr(i, 12)
If arr(i, 12) > 0.5 Then arr2(x(CStr(arr(i, 21))), 2) = arr2(x(CStr(arr(i, 21))), 2) + 1

If arr(i, 7) = "LSP" Then
arr2(x(CStr(arr(i, 21))), 5) = arr2(x(CStr(arr(i, 21))), 5) + 1
If arr(i, 12) > 24 Then
arr2(x(CStr(arr(i, 21))), 6) = arr2(x(CStr(arr(i, 21))), 6) + 1
arr2(x(CStr(arr(i, 21))), 7) = arr2(x(CStr(arr(i, 21))), 7) + arr(i, 12)
End If
End If
End If
Next
[C2].Resize(UBound(arr2), 8) = arr2
[F2].Resize(UBound(arr2), 1) = "=RC[-1]/RC[-3]"
[J2].Resize(UBound(arr2), 1) = "=RC[-1]/RC[-3]"
[C2].Resize(UBound(arr2), 8) = [C2].Resize(UBound(arr2), 8).Value
[E2].Resize(UBound(arr2), 1) = "=100*RC[-1]/RC[-2] &""%"""
[I2].Resize(UBound(arr2), 1) = "=100*RC[-1]/RC[-2] &""%"""
[C2].Resize(UBound(arr2), 8).SpecialCells(4) = 0
[C2].Resize(UBound(arr2), 8) = [C2].Resize(UBound(arr2), 8).Value
[C2].Resize(UBound(arr2), 8).Replace "#DIV/0!", "0"
Application.ScreenUpdating = True

End Sub

学习了山菊花斑竹的数组入门帖，很多都可以看懂了。只剩下标黄色的没懂，麻烦指点一下，谢谢！

为便于理解就把代码附件都带上了，别见怪

[em04]