1
Excelファイルが分割されています：コードは1列、説明は1列、価格は1列、サイズは1列です。VBはExcelの列を1つしか考慮しません
VBでは、各フィールドを選択してAccessで作成したデータベースにエクスポートする必要があります。 説明列で作業する場合、問題が発生します。VBは各行を1つだけとみなしているため、dbの1つの列にすべての製品の完全な説明があります。私はより良い私が言ったことを説明しようとすることができ、上記私はそれを投稿例で
。私が望むのは、製品ごとに説明が正しく報告されていることです。
これは私が書いたコードです：
Private Sub Importa_XLS(ByVal fileData As String, ByVal dbVuoto As String, ByVal dbDest As String)
If My.Computer.FileSystem.FileExists(dbDest) Then My.Computer.FileSystem.DeleteFile(dbDest)
My.Computer.FileSystem.CopyFile(dbVuoto, 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 As Integer = 2
Dim oldCap, oldPar, vett() As String
Dim capitolo As New cCapitolo
Dim paragrafo As New cParagrafo
'For r As Integer = 196 To grid.RowCount = 5549
For r = 2 To grid.RowCount - 1
vett = Split(grid(r, 1).Text)
total = UBound(Split(grid(r, 1).Text, "."))
If total = 0 Then 'capitolo
oldCap = capitolo.Cod
oldPar = paragrafo.Cod
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(capitolo)
End If
End If
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, 2).Text.Length > 255 Then
capitolo.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
capitolo.Descrizione = grid(r, 3).Text.ToString
End If
'capitolo.Cod = grid(r, 1).Text.ToString
End If
If total = 1 Then 'voce
Dim voce As New cVoce
If grid(r, 1).Text.Length > 255 Then
voce.Descrizione = grid(r, 2).Text.ToString.Substring(0, 252) + "..."
Else
voce.Descrizione = grid(r, 2).Text
End If
voci.Add(voce)
End If
If total = 2 Then 'sottovoce
Dim sottovoce As New cVoce
sottovoce.Descrizione = grid(r, 3).Text
If grid(r, 1).Text.Length > 255 Then
sottovoce.DescBreve = grid(r, 2).Text.ToString.Substring(0, 252) + "..."
Else
sottovoce.DescBreve = grid(r, 2).Text
End If
sottovoce.Prezzo1 = grid(r, 3).Text
sottovoce.Prezzo2 = sottovoce.Prezzo1
sottovoce.Prezzo3 = sottovoce.Prezzo1
sottovoce.Prezzo4 = sottovoce.Prezzo1
sottovoce.UniMi = grid(r, 2).Text
sottovoce.Separatore = "."
End If
Next
capitoli.Salva_DB(dbDest)
paragrafi.Salva_DB(dbDest)
voci.Salva_DB(dbDest)
End Sub
Public Sub Salva_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
db.close_DB()
End Sub
Public Sub Salva_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("Cod_Capitolo").Value = par.Cod_Capitolo
rs("Descrizione").Value = par.Descrizione
rs("Cod").Value = par.Cod
rs.Update()
Next
db.close_DB()
End Sub
Public Sub Salva_DB(ByVal PathDB As String)
Dim db As New cDB
db.connetti_DB(PathDB)
db.get_rs("DELETE * FROM Voci")
db.get_rs("SELECT * 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
rs("Cod_SottoParagrafo").Value = v.Cod_SottoParagrafo
'rs("Articolo").Value = v.Genera_Articolo
rs("Descrizione").Value = v.Descrizione
If v.Prezzo1 IsNot Nothing Then
rs("Prezzo1").Value = Val(v.Prezzo1.Replace(",", "."))
End If
If v.Prezzo2 IsNot Nothing Then
rs("Prezzo2").Value = Val(v.Prezzo2.Replace(",", "."))
End If
If v.Prezzo3 IsNot Nothing Then
rs("Prezzo3").Value = Val(v.Prezzo3.Replace(",", "."))
End If
If v.Prezzo4 IsNot Nothing Then
rs("Prezzo4").Value = Val(v.Prezzo4.Replace(",", "."))
End If
rs.Update()
Next
db.close_DB()
End Sub
は私を助けることができる誰もが、そこにしてくださいますか？
残念ながらエラーがExcelファイル内にあります。実際、記述列は各製品の説明を含むブロックである。ファイルを修正すると、それは動作します。とにかくありがとうございます – Marietto
大歓迎 –