如何在vb中使用对象数组

Posted

技术标签:

【中文标题】如何在vb中使用对象数组【英文标题】:How to use an array of objects in vb 【发布时间】:2017-09-28 09:48:45 【问题描述】:

我正在尝试学习如何使用对象数组,但我不太了解。我必须将数据从 Excel 文件导出到 Access db。

Private Sub Import_XLS(ByVal fileData As String, ByVal dbEmpty As String, ByVal dbDest As String)

    If My.Computer.FileSystem.FileExists(dbDest) Then My.Computer.FileSystem.DeleteFile(dbDest)
    My.Computer.FileSystem.CopyFile(dbEmpty, dbDest)

    Dim capitoli As New cCapitoli
    Dim paragrafi As New cParagrafi
    Dim voci As New cVoci
    Dim total As Integer
    Dim fileStream As FileStream = New FileStream(fileData, FileMode.Open)
    Dim file(fileStream.Length) As Byte

    fileStream.Read(file, 0, fileStream.Length)

    fileStream.Close()

    Dim ExcelEngine As ExcelEngine = New ExcelEngine()
    Dim application As IApplication = ExcelEngine.Excel
    Dim workbook As IWorkbook = application.Workbooks.Open(New MemoryStream(file), ExcelOpenType.Automatic)

    Dim gecc As New Syncfusion.GridExcelConverter.GridExcelConverterControl

    Dim grid As New GridModel
    gecc.ExcelToGrid(fileData, grid.Model)
    Dim r, flag As Integer
    Dim oldCap, oldPar, oldVoce, oldSottovoce, vett(), stringaCap, stringaPar, stringaVoce, stringaSottovoce, c_Voc, p_Voc As String
    Dim capitolo As New cCapitolo
    Dim paragrafo As New cParagrafo
    Dim voce, sottoVoce As New cVoce

    For r = 2 To grid.RowCount - 1
        vett = Split(grid(r, 1).Text)
        total = UBound(Split(grid(r, 1).Text, "."))
        If grid(r, 1).Text <> "" Then
            Select Case total
                Case 0 'capitolo & paragrafo
                    Dim cap As New cCapitolo
                    flag = 1
                    oldCap = capitolo.Cod
                    oldPar = paragrafo.Cod
                    capitolo.Cod = grid(r, 1).Text.Substring(0, 1)
                    capitolo.Descrizione = grid(r, 3).Text

                    If Left(vett(0), 1) >= Chr(65) And Left(vett(0), 1) <= Chr(90) Then
                        capitolo.Cod = Left(vett(0), 1)
                        If capitolo.Cod <> oldCap Then
                            capitoli.Add(cap)
                        End If
                    End If

                    If grid(r, 3).Text.Length > 255 Then
                        capitolo.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
                    Else
                        capitolo.Descrizione = grid(r, 3).Text.ToString
                    End If
                    stringaCap = capitolo.Descrizione

                    If Left(vett(0), 2) >= Chr(65) And Left(vett(0), 2) <= Chr(90) Then
                        paragrafo.Cod = Left(vett(0), 2)
                        If paragrafo.Cod <> oldPar Then
                            paragrafi.Add(paragrafo)
                        End If
                    End If
                    If grid(r, 3).Text.Length > 255 Then
                        paragrafo.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
                    Else
                        paragrafo.Descrizione = grid(r, 3).Text.ToString
                    End If
                    stringaPar = paragrafo.Descrizione

                Case 1 'voce
                    Dim voc As New cVoce
                    flag = 2
                    c_Voc = voc.Cod_Capitolo
                    p_Voc = voc.Cod_Paragrafo
                    voc.Cod_Capitolo = grid(r, 1).Text.Substring(0, 1)
                    voc.Cod_Paragrafo = grid(r, 1).Text.Split(".")(0)
                    voc.Cod_Voce = Right(vett(0), 2)
                    If grid(r, 3).Text.Length > 255 Then
                        voce.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
                    Else
                        voce.Descrizione = grid(r, 3).Text.ToString
                    End If
                    stringaVoce = voce.Descrizione
                    'voce.Articolo = "voc.Cod_Capitolo & "." & voc.Cod_Paragrafo & "." & voc.Cod_Voce"
                    voci.Add(voc)

                Case 2 'sottovoce
                    flag = 3
                    oldSottovoce = voce.Cod_SottoVoce
                    sottoVoce.Cod_SottoVoce = Left(vett(0), 2)
                    sottoVoce.Cod_Voce = Left(vett(0), 5)  'come voce
                    sottoVoce.Cod_Capitolo = grid(r, 1).Text.Substring(0, 1)
                    sottoVoce.Cod_Paragrafo = grid(r, 1).Text.Split(".")(0)

                    If sottoVoce.Cod_SottoVoce <> oldSottovoce Then
                        voci.Add(sottoVoce)
                    End If
                    If grid(r, 3).Text.Length > 255 Then
                        sottoVoce.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
                    Else
                        sottoVoce.Descrizione = grid(r, 3).Text
                    End If
                    stringaSottovoce = sottoVoce.Descrizione
                    Do While grid(r, 1).ToString = ""
                        If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then
                            Dim s As String
                            s = grid(r, 3).ToString
                            capitolo.Descrizione = grid((r - 1), 3).ToString & s
                        End If
                    Loop
                    sottoVoce.Cod_Voce = Left(vett(0), 5)
                    sottoVoce.Prezzo1 = grid(r, 12).Text
                    sottoVoce.Prezzo2 = sottoVoce.Prezzo1
                    sottoVoce.Prezzo3 = sottoVoce.Prezzo1
                    sottoVoce.Prezzo4 = sottoVoce.Prezzo1
                    sottoVoce.UniMi = grid(r, 11).Text
                    sottoVoce.Separatore = "."
            End Select
        Else
            If flag = 1 Then
                stringaCap = grid(r, 3).Text
                capitolo.Descrizione = stringaCap & grid(r, 3).Text
                stringaPar = grid(r, 3).Text
                paragrafo.Descrizione = stringaPar & grid(r, 3).Text
            End If

            If flag = 2 Then
                stringaVoce = grid(r, 3).Text
                voce.Descrizione = voce.Descrizione & stringaVoce
            End If

            If flag = 3 Then
                stringaSottovoce = grid(r, 3).Text
                sottoVoce.Descrizione = stringaSottovoce & grid(r, 3).Text
            End If

        End If

    Next r

    capitoli.Salva_DB(dbDest)
    paragrafi.Salva_DB(dbDest)
    voci.Salva_DB(dbDest)

End Sub 'Import_XLS

保存函数:

Public Sub Save_DB(ByVal PathDB As String)

    Dim db As New cDB

    db.connetti_DB(PathDB)
    db.get_rs("DELETE * FROM Capitoli")
    db.get_rs("SELECT * FROM Capitoli")

    Dim rs As ADODB.Recordset = db.RecordSet
    For Each cap As cCapitolo In Me
        rs.AddNew()
        rs("Descrizione").Value = cap.Descrizione
        rs("Cod").Value = cap.Cod
        rs.Update()
    Next rs

    db.close_DB()

End Sub 'Save_DB

Public Sub Save_DB(ByVal PathDB As String)

    Dim db As New cDB

    db.connetti_DB(PathDB)
    db.get_rs("DELETE * FROM Paragrafi")
    db.get_rs("SELECT * FROM Paragrafi")

    Dim rs As ADODB.Recordset = db.RecordSet
    For Each par As cParagrafo In Me
        rs.AddNew()

        rs("Descrizione").Value = par.Descrizione
        rs("Cod").Value = par.Cod

        rs.Update()
    Next par

    db.close_DB()

End Sub 'Save_DB

Public Sub Save_DB(ByVal PathDB As String)

    Dim db As New cDB

    db.connetti_DB(PathDB)
    db.get_rs("DELETE * FROM Voci")
    db.get_rs("SELECT Cod_Capitolo, Cod_Paragrafo, Descrizione, Cod_Voce, Cod_Sottovoce, UniMi, Prezzo1 FROM Voci")

    Dim rs As ADODB.Recordset = db.RecordSet
    For Each v As cVoce In Me
        rs.AddNew()
        rs("Cod_Voce").Value = v.Cod_Voce
        rs("Cod_SottoVoce").Value = v.Cod_SottoVoce
        rs("Cod_Capitolo").Value = v.Cod_Capitolo
        rs("Cod_Paragrafo").Value = v.Cod_Paragrafo

        If v.Prezzo1 IsNot Nothing Then
            rs("Prezzo1").Value = Val(v.Prezzo1.Replace(",", "."))
        End If
        rs("UniMi").Value = v.UniMi

        rs.Update()
    Next v

    db.close_DB()

End Sub Save_DB

只有当我的 Excel 中有一行时,此代码才能正常工作。显然我有不止一行,所以我的 Excel 文件的值被覆盖到数据库中。据我了解,如果我想添加很多对象,我必须使用数组。 在我的每个循环中,我使用相同的对象,确实它不起作用。

我的 Excel 是这样的:

如何修复我的代码?

【问题讨论】:

【参考方案1】:

通常的做法是使用对象的Collection(在VBA 中,Array 相当不灵活)。

创建一个集合:

Dim MyCollection As New Collection

将对象添加到集合中:

MyCollection.Add MyObject

遍历集合中的所有对象(MyObject 具有 Variant 作为类型)

For Each MyObject In MyCollection
    'Do Something
Next MyObject

【讨论】:

但是这样我必须为每个做 3 次,因为我有 3 个对象,对吧? 不,For Each 遍历添加到集合中的所有对象。您也可以按编号引用对象(例如MyCollection(1)MyCollection(2)MyCollection(3)),但循环通常更容易 如果您使用 3 种不同类型的对象,请使用 3 个集合和 3 个用于每个循环(或者,如果它们明显相关,并且始终是三个对象,则可以考虑存储 3数组中的相关对象,以及集合中的那些数组)。由于您的代码不是英文,我很难准确理解发生了什么。 你可以做Dim ObjArray(3) As Variant,然后Set ObjArray(1) = FirstObjectSet ObjArray(2) = SecondObjectSet ObjArray(3) = ThirdObject。然后MyCollection.Add ObjArray,然后在For Each MyObject In MyCollection,可以使用MyObject(1)MyObject(2)MyObject(3) 作为一般规则,如果您确切知道有多少对象(在这种情况下:3 个对象),请选择一个数组,如果您想拥有可变数量的对象(在本例:每行一组 3 个对象)。所以同时使用两者在这里是有效的

以上是关于如何在vb中使用对象数组的主要内容,如果未能解决你的问题,请参考以下文章

在 VB6/VBA 中是不是真的需要对象清除/数组释放(优点/缺点?)

c#如何在一个窗体中调用另一个窗体的数组对象

将字符串数组从 VB6 传递到 COM 对象

vb中如何让一个按钮调用另一个按钮中的数组

在VBScript中调整对象内部的数组大小

使用 NamePipe [进程间通信] VB.NET 传输对象