回 帖 发 新 帖 刷新版面

主题:[讨论]VBA代码转VB问题

Sub test_1()
    Rem Private Sub CommandButton1_Click()
    Dim wb As Workbook, f, drr, brr(), crr(), d As Object
    Dim m As Integer, n As Long, lr As Long, temp As String, i As Long, j As Integer, k As Integer
    f = Application.GetOpenFilename(fileFilter:="Microsoft Excel Files (*.xls;*.xlsx),*.xls;*.xlsx", MultiSelect:=True, Title:="Ñ¡ÔñºÏ²¢Îļþ")
    If TypeName(f) = "Boolean" Then Exit Sub
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Clear
    For k = 1 To UBound(f)
        If f(k) <> ThisWorkbook.FullName Then
            Set wb = Workbooks.Open(f(k))
            m = m + 1
            With wb.Sheets(1)
                If m = 1 Then .Rows("1:1").Copy Cells(1, 1)
                lr = .Range("A1").End(xlDown).Row
                If lr > 1 Then '1
                    drr = .Range("A2:j" & lr) '&Otilde;&acirc;&Agrave;&iuml;&Iuml;&Acirc;&Ograve;&AElig;&Ograve;&raquo;&ETH;&ETH; A2
                    For i = 1 To UBound(drr)
                        temp = "" '&Otilde;&acirc;&Agrave;&iuml;·&Aring;&Ocirc;&Uacute;temp&cedil;&sup3;&Ouml;&micro;&Ouml;&reg;&Ccedil;°
                        For j = 1 To 10
                            temp = temp & drr(i, j)
                        Next
                        If Not d.exists(temp) Then
                            n = n + 1
                            d(temp) = ""
                            ReDim Preserve brr(1 To 10, 1 To n)
                            For j = 1 To 10
                                brr(j, n) = drr(i, j)
                            Next
                        End If
                    Next
                End If
            End With
            wb.Close False
        End If
    Next
    If n > 0 Then
        ReDim crr(1 To n)
        With Cells(2, 1).Resize(n, 10) '&Aring;&Aring;&ETH;ò3
            .Value = WorksheetFunction.Transpose(brr)
            .Borders.LineStyle = xlContinuous
        End With
        With CreateObject("VBScript.RegExp")
            .Pattern = "(\d{1,8})"
             For i = 1 To n
               If .test(brr(1, i)) Then crr(i) = .Execute(brr(1, i))(0)
             Next
         End With
        Cells(2, 11).Resize(n) = WorksheetFunction.Transpose(crr) '&Aring;&Aring;&ETH;ò2
        Range("A3").Resize(n, 11).Sort Key1:=Range("k3").Resize(n) '±í&Iacute;·&Icirc;&raquo;&Ouml;&Atilde;&pound;¨A3&pound;&ordm;&Iacute;·&sup2;&iquest;  A2&pound;&ordm;&Icirc;&sup2;&sup2;&iquest;&pound;&copy;
        Columns("k:k").ClearContents
    End If
    Application.ScreenUpdating = True
    MsgBox "&acute;&brvbar;&Agrave;í&Iacute;ê±&Iuml;"
End Sub


请教各位前辈,以上是VBA的代码,在VB中如何编写,请老师帮忙。。谢谢

回复列表 (共3个回复)

沙发

光学vba没有两天,爱莫能助

板凳

很多东东不一样的

3 楼

引用Microsoft Office 11.0 Object Library.
把在VBA里的“顶级对象”如Application、Range、Cell等换成相应的对象。

我来回复

您尚未登录,请登录后再回复。点此登录或注册