Foxtable(狐表)用户栏目专家坐堂 → 如何将XLS.Book改成MSEXCEL?


  共有2783人关注过本帖树形打印复制链接

主题:如何将XLS.Book改成MSEXCEL?

帅哥哟,离线,有人找我吗?
wh420
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
如何将XLS.Book改成MSEXCEL?  发帖心情 Post By:2016/8/29 12:05:00 [显示全部帖子]

见如下代码,是用XLS.BOOK实现的,如何改成MSEXCEL,并且ary(i,j)数组的形式
For j As Integer = 0 To val.Value
                        If Sheet1(i, j).Text > ""  AndAlso dic.ContainsKey(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then
                            If Forms("窗口1").Controls("RBt5").checked =True Then

                                Sheet1(i, j).Value = dic(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                            Else If Forms("窗口1").Controls("RBt6").checked =True Then 
                                If Forms("窗口1").Controls("RBt1").checked =True Then

                                    Sheet1(i, j).Value = Sheet1(i, j).Text & "|" & dic(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                                Else If Forms("窗口1").Controls("RBt2").checked=True Then

                                    Sheet1(i, j).value = Sheet1(i, j).Text & vbcrlf & dic(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                                Else If Forms("窗口1").Controls("RBt4").checked=True Then

                                    Sheet1(i, j).Value = Sheet1(i, j).Text
                                    Sheet1(i, j+1).Value = dic(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                                End If
                            End If
                        End If
                    
Next


 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/8/29 14:38:00 [显示全部帖子]

我看了提高效率的那个,但还不是我想要的。我要实现的功能是把一个字典文件的内容与另外一EXCEL做对比,把字典里有的填充到另外一个EXCEL中(该功能已经实现)但不想处理隐藏的行和列,原来用XLS.BOOK来判断<>0的列,但是不准确,所以要改成MSEXCEL方式,麻烦老师给看看下面的代码如何更改。这是完整的代码
Dim path As String = args(0)
'//准备字典信息
'try
Dim dic As new Dictionary(of String,String)
Dim dicfile As String =  Forms("窗口1").Controls("TextBox2").value

Dim Book As New XLS.Book(dicfile) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表

For i As Integer = 0 To Sheet.Rows.Count-1
    If dic.ContainsKey(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) = False Then
        dic.add(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""),Sheet(i, 1).Text)
    End If
Next

'//开始
For Each file As String In FileSys.GetFiles(path)
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim Book1 As New XLS.Book(file)
        For k As Integer = 0 To Book1.Sheets.Count-1 '//多个sheet的处理
            Dim Sheet1 = Book1.Sheets(k)
            For i As Integer = 0 To Sheet1.Rows.Count-1
                
                For j As Integer = 0 To sheet1.Cols.Count-1
                    If Sheet1(i, j).Text > "" AndAlso dic.ContainsKey(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then
                        If Forms("窗口1").Controls("RBt1").checked  Then
                            Sheet1(i, j).Value = Sheet1(i, j).Text & "|" & dic(Sheet1(i, j).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                        End If
                    End If
                Next
            Next
        Next
    End If
Next

For Each p As String In FileSys.GetDirectories(path)
    Functions.Execute("对比函数", p)
Next

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/8/29 14:40:00 [显示全部帖子]

注:以上代码最好能用高效率的方式实现,因为处理的数据较多。

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/1 16:41:00 [显示全部帖子]

老师帮忙看看哪里不对,报错“索引超出了数组界限”

Dim path As String = args(0)

Dim app As new MsExcel.Application

Dim dic As new Dictionary(of String,String)
Dim dicfile As String =  Forms("窗口1").Controls("TextBox2").value

Dim Book As New XLS.Book(dicfile) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表

For i As Integer = 0 To Sheet.Rows.Count-1
    If dic.ContainsKey(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) = False Then
        dic.add(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""),Sheet(i, 1).Text)
    End If
Next

'//开始
For Each file As String In FileSys.GetFiles(path)
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim wb=app.WorkBooks.Open(file)

        For k As Integer = 1 To wb.worksheets.count '//多个sheet的处理
            Dim ws As msexcel.worksheet=wb.worksheets(k)
            Dim rg As msexcel.range=ws.usedrange
            Dim ary =rg.value

            'Dim Sheet1 = Book1.Sheets(k)
            For i As Integer = 1 To rg.Rows.Count
                For j As Integer = 1 To rg.Columns.Count



                    If ary(i+1,j+1) > "" AndAlso dic.ContainsKey(ary(i+1,j+1).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then

                        If Forms("窗口1").Controls("RBt1").checked  Then
                            ws.Cells(i+1, j+1).Value = ary(i+1,j+1) & "|" & dic(ary(i+1,j+1).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                            msgbox(ws.Cells(i+1, j+1).Value )
                        End If
                    End If
                Next
            Next
        Next
        wb.save()
        app.quit()
    End If
Next

For Each p As String In FileSys.GetDirectories(path)
    Functions.Execute("对比函数", p)
Next

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/1 16:59:00 [显示全部帖子]

老师帮忙看看

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/2 0:22:00 [显示全部帖子]

是啊,那应该如何改一下?

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/2 15:36:00 [显示全部帖子]

如果按标红处的代码手动输入一个数值(如:输入10)则报错“索引超出了数组界限”,如果采用标蓝处的代码则正常,但不是我想要的。我想把列数通过输入固定而不是表格中有多少列就处理多少列,应该如何修改?
For Each file As String In FileSys.GetFiles(path)
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim wb=app.WorkBooks.Open(file)
        'Dim Book1 As New XLS.Book(file)
        For k As Integer = 1 To wb.worksheets.count '//多个sheet的处理
            Dim ws As msexcel.worksheet=wb.worksheets(k)
            Dim rg As msexcel.range=ws.usedrange
            Dim ary =rg.value

            'Dim Sheet1 = Book1.Sheets(k)
            For i As Integer = 1 To rg.Rows.Count
                ‘For j As Integer = 1 To rg.Columns.Count
                For j As Integer = 1 To val.value


                    If ary(i,j) > "" AndAlso dic.ContainsKey(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then

                        If Forms("窗口1").Controls("RBt1").checked  Then
                            ws.Cells(i, j).Value = ary(i,j) & "|" & dic(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                            msgbox(ws.Cells(i, j).Value )
                        End If
                    End If
                Next
            Next
        Next
        wb.save()
        app.quit()
    End If
Next

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/2 16:07:00 [显示全部帖子]

明白了,谢谢

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/5 13:02:00 [显示全部帖子]

标红的地方执行是报错:未找到类型Double的公共成员“ToLower"是怎么回事?

Dim path As String = args(0)
Dim val As WinForm.NumericComboBox = Forms("窗口1").Controls("NumericComboBox1")
Dim app As new MsExcel.Application

Dim dic As new Dictionary(of String,String)
Dim dicfile As String =  Forms("窗口1").Controls("TextBox2").value

Dim Book As New XLS.Book(dicfile) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表

For i As Integer = 0 To Sheet.Rows.Count-1
    If dic.ContainsKey(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) = False Then
        dic.add(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""),Sheet(i, 1).Text)
    End If
Next
msgbox(1)
'For Each k As String In dic.Keys '显示所有键及其对应的值
'Output.Show(K & "|" & dic(k))
'Next
'Dim file As object
'//开始
For Each file As String In FileSys.GetFiles(path)
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim wb=app.WorkBooks.Open(file)
        'Dim Book1 As New XLS.Book(file)
        For k As Integer = 1 To wb.worksheets.count '//多个sheet的处理
            Dim ws As msexcel.worksheet=wb.worksheets(k)
            Dim rg As msexcel.range=ws.usedrange
            Dim ary =rg.value
            
            For i As Integer = 1 To rg.Rows.Count
                For j As Integer = 1 To rg.Columns.count
                    'If i= 2 Then
                        'Continue For
                        
                        If ary(i,j) > "" AndAlso dic.ContainsKey(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then
                          
                            If Forms("窗口1").Controls("RBt1").checked  Then
                                ws.Cells(i, j).Value = ary(i,j) & "|" & dic(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
                                msgbox(3)
                            End If
                        End If
                    'End If
                Next
            Next
        Next
        wb.save()
        app.quit()
    End If
Next

For Each p As String In FileSys.GetDirectories(path)
    Functions.Execute("对比函数", p)
Next

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10574 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2016/9/5 13:22:00 [显示全部帖子]

麻烦老师再给看看吧

 回到顶部
总数 17 1 2 下一页