前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA转VB.Net VSTO学习记录-3

VBA转VB.Net VSTO学习记录-3

作者头像
哆哆Excel
发布2022-10-31 15:39:14
6400
发布2022-10-31 15:39:14
举报
文章被收录于专栏:哆哆Excel

yhd-VBA转VB.NetVSTO学习记录-3

【目标】想搞个插件

【学习内容】

本次学习内容有VB.net数组、列表、字典

学习它们相关的属性与方法

以下学习在VSTO外接程序中测试通过

【目录】

数据类型

—维数组输出二维数据输出字典输出

读取单元格

读取区域读取一行中A1:J1读取你选中区域

【代码】

【放上代码,方便复制、粘贴学习之用】

代码语言:javascript
复制
'一维数组写入单位元格测试,Ubound上标界,Length长度
    Private Sub Button4_Click(sender As Object, e As RibbonControlEventArgs) Handles Button4.Click
        Dim Data1Arr1() As Integer = {1, 2, 3}
        Dim Ub As Integer = UBound(Data1Arr1)
        Dim Len As Integer = Data1Arr1.Length
        xlapp.ActiveSheet.cells.clear()
        MsgBox("数组上标界:" + Ub.ToString() + vbCrLf + "数组长度" + Len.ToString())
        '输出-1,有问题
        xlapp.ActiveSheet.Range("A1:D1").Value = Data1Arr1
'输出-2,有问题
        xlapp.ActiveSheet.cells(2, 1).value = Data1Arr1
        '输出-3,OK
        xlapp.ActiveCell.Resize(1, Len).Value = Data1Arr1
'输出-4,OK
        xlapp.ActiveSheet.cells(10, 1).Resize(Len, 1).value = xlapp.WorksheetFunction.Transpose(Data1Arr1)
    End Sub
    '二维数据输出,获取数组中指定维度最后一个元素的索引GetUpperBound(0)行UBound(Data2Arr1, 1) + 1,GetUpperBound(1)列UBound(Data2Arr1, 2) + 1
Private Sub Button5_Click(sender As Object, e As RibbonControlEventArgs) Handles Button5.Click
        Dim Data2Arr1(2, 3) As String
For i As Integer = 0 To 2
For j As Integer = 0 To 3
                Data2Arr1(i, j) = i.ToString() + "行" + j.ToString() + "列"
            Next
        Next
        Dim myRow As Integer = Data2Arr1.GetUpperBound(0) + 1
        Dim myCol As Integer = Data2Arr1.GetUpperBound(1) + 1
        Dim myRow2 As Integer = UBound(Data2Arr1, 1) + 1
        Dim myCol2 As Integer = UBound(Data2Arr1, 2) + 1
        xlapp.ActiveSheet.cells.clear()
        MsgBox("获取数组中指定维度最后一个元素的索引GetUpperBound(0)+1=" + myRow.ToString() + vbCrLf + "UBound(Data2Arr1, 1) + 1=" + myRow2.ToString() + vbCrLf + "GetUpperBound(1)=" + myCol.ToString() + vbCrLf + myCol2.ToString())
'输出方式一,OK
        xlapp.ActiveCell.Resize(myRow, myCol).Value = Data2Arr1
        '输出方式二,有问题
        xlapp.ActiveSheet.cells(5, 5).Value = Data2Arr1
'输出方式三,OK
        For i As Integer = Data2Arr1.GetLowerBound(0) To Data2Arr1.GetUpperBound(0)
            For j As Integer = Data2Arr1.GetLowerBound(1) To Data2Arr1.GetUpperBound(1)
                xlapp.ActiveSheet.cells(10, 10).Offset(i, j) = Data2Arr1(i, j)
            Next
        Next
    End Sub
    '读取区域
Private Sub Button6_Click(sender As Object, e As RibbonControlEventArgs) Handles Button6.Click
'Dim star_arr(,) As Integer = {{1, 2, 3}, {4, 5, 6}}
        'xlapp.ActiveSheet.Cells(1, 1).Resize(2, 3).value = star_arr
        Dim Read_arr As Array = xlapp.ActiveSheet.Range("A1:C3").value
        MsgBox(UBound(Read_arr, 1))
        MsgBox(UBound(Read_arr, 2))
        MsgBox(Read_arr(1, 2))
    End Sub
'字典输出
    Private Sub Button8_Click(sender As Object, e As RibbonControlEventArgs) Handles Button8.Click
        Dim Dic As New Dictionary(Of String, Integer)
        Dic.Add("Dot", 20)
        Dic.Add("Net", 1)
        Dic.Add("Perls", 10)
        Dic.Add("Visual", -1)
        Dim DicList As New List(Of String)(Dic.Keys)
        Dim i As Integer
        '下面
        MsgBox("下面准备遍历列表,输出到当前单元格")
For Each li As String In DicList
            xlapp.ActiveCell.Offset(i, 0).Value = li
            i = i + 1
        Next
'错误的输出方式
        'xlapp.ActiveSheet.cells(2, 5).Resize(1, Dic.Keys.Count).Value = DicList
        MsgBox("遍历Dic.keys")
For Each d As String In Dic.Keys
            MsgBox("字典输出" + vbCrLf + "key=" + d + vbCrLf + "item=" + Dic.Item(d).ToString())
        Next
'错误的输出方式
        'xlapp.ActiveSheet.cells(1, 5).Resize(1, Dic.Keys.Count).Value = Dic.kes
'字典keys 复制到数组, 再输出到工作表
        MsgBox("字典.keys.CopyTo() 复制到数组, 再输出到工作表")
        Dim DicArr(Dic.Keys.Count) As String
        Dic.Keys.CopyTo(DicArr, 0)
        xlapp.ActiveSheet.cells(1, 5).Resize(1, Dic.Keys.Count).Value = DicArr
        Dim DicArrList As New List(Of Integer)
        For Each d2 As String In Dic.Keys
            DicArrList.Add(Dic.Item(d2))
        Next
        MsgBox(DicArrList.Count)
    End Sub
    '读取一行中A1:J1
Private Sub Button7_Click(sender As Object, e As RibbonControlEventArgs) Handles Button7.Click
        Dim A1J1 As Excel.Range = xlapp.ActiveSheet.Range("A1:J1")
        With A1J1
            .Borders.LineStyle = 1
            .Interior.Color = 65535
'.NumberFormatLocal = "@"
        End With
        MsgBox("单元格总数:" + A1J1.Count.ToString())
        If xlapp.WorksheetFunction.CountA(A1J1) <> 0 Then
            Dim Read_arr As Array = A1J1.Value
            MsgBox("行数:" + UBound(Read_arr, 1).ToString() + "列数:" + UBound(Read_arr, 2).ToString())
            For i As Integer = LBound(Read_arr, 1) To UBound(Read_arr, 1)
                For j As Integer = LBound(Read_arr, 2) To UBound(Read_arr, 2)
                    MsgBox(Prompt:=Read_arr(i, j), Title:=i.ToString() + "," + j.ToString())
                Next
            Next
        Else
            MsgBox("A1:J1全为空,将要退出")
            Exit Sub
        End If
    End Sub
    '读取你选中区域,再赋值给数组,再在O1后显示出信息
Private Sub Button9_Click(sender As Object, e As RibbonControlEventArgs) Handles Button9.Click
        Dim myselection As Excel.Range = xlapp.Selection
        Dim myselArr As Object = myselection.Value
        With xlapp.ActiveSheet.cells(1, 15)
            .resize(100, 100).clearcontents
            .value = "你选中区域是:" + myselection.Address
            .offset(1, 0).value = "单元格总数:" + myselection.Count.ToString()
            .offset(2, 0).value = "数组行数:" + UBound(myselArr, 1).ToString() + "数组列数:" + UBound(myselArr, 2).ToString()
'把数组输出
            For i As Integer = LBound(myselArr, 1) To UBound(myselArr, 1)
                For j As Integer = LBound(myselArr, 2) To UBound(myselArr, 2)
                    .offset(2 + i, j).value = myselArr(i, j)
                Next
            Next
        End With
    End Sub
本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-02-24,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 哆哆Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档