2024-07-12
한어Русский языкEnglishFrançaisIndonesianSanskrit日本語DeutschPortuguêsΕλληνικάespañolItalianoSuomalainenLatina
Les étapes pour cette macro VBA sont les suivantes :
Conseil : Étant donné que les problèmes tels que le cas du texte SQL sont en réalité plus complexes, utilisez cet exemple avec prudence.
Certaines situations inattendues, telles que des champs contenant des) values
Et ainsi de suite, c'est surtout un problème de positionnement, et ensuite de longueur de la valeur, au cas où il y aurait aussi quelque chose dans la valeur,
Virgules, puis espaces et autres problèmes ;
Il devrait être plus facile d'utiliser Python ;
ce qui suitVBA
Le script est à titre de référence ; vous pouvez lier les boutons vous-même ;
Pour ce style :
insert into aaa (aa,bb,cc) values ('2','','3aa');
insert into aaa (aa,bb,cc) values ('1',null,'');
' +++++++++++++++++++++++++++++++++++++++++++++++++++
' author Mr.qyb_y
' Version 1.0.0
' Date 2024-07-09 21:10
' +++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ImportSQLToExcel()
Dim fd As FileDialog
Dim filePath As String
Dim fileContent As String
Dim lines As Variant
Dim line As Variant
Dim sht As Worksheet
Dim currentSheetIndex As Integer
' 创建文件对话框以选择SQL文件
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select SQL File"
fd.Filters.Add "SQL Files", "*.sql", 1
If fd.Show = -1 Then
filePath = fd.SelectedItems(1)
Else
MsgBox "No file selected.", vbExclamation
Exit Sub
End If
' 读取文件内容
fileContent = ReadFileContent(filePath)
lines = Split(fileContent, vbCrLf)
currentSheetIndex = Sheets.Count
' 解析文件内容并插入到Excel中
For Each line In lines
If InStr(line, "insert into") > 0 Then
Dim tableName As String
Dim columnNames As String
tableName = ExtractTableName(CStr(line)) ' 强制转换为字符串类型
columnNames = ExtractColumnNames(CStr(line)) ' 提取列名
' 检查工作表是否已经存在
On Error Resume Next
Set sht = Sheets(tableName)
On Error GoTo 0
' 如果工作表不存在,则创建新的工作表,并插入列名
If sht Is Nothing Then
Set sht = Sheets.Add(After:=Sheets(currentSheetIndex))
sht.Name = tableName
currentSheetIndex = currentSheetIndex + 1
' 插入列名
InsertColumnNames sht, columnNames
End If
' 插入数据
InsertDataIntoSheet sht, CStr(line) ' 强制转换为字符串类型
End If
Next line
MsgBox "Data imported successfully!", vbInformation
End Sub
Function ReadFileContent(filePath As String) As String
Dim fileNumber As Integer
Dim content As String
fileNumber = FreeFile
Open filePath For Input As fileNumber
content = Input(LOF(fileNumber), fileNumber)
Close fileNumber
ReadFileContent = content
End Function
Function ExtractTableName(ByVal sqlLine As String) As String ' 明确指定参数类型
Dim startPos As Integer
Dim endPos As Integer
startPos = InStr(sqlLine, "insert into") + Len("insert into ")
endPos = InStr(startPos, sqlLine, " (")
ExtractTableName = Trim(Mid(sqlLine, startPos, endPos - startPos))
End Function
Function ExtractColumnNames(ByVal sqlLine As String) As String
Dim startPos As Integer
Dim endPos As Integer
startPos = InStr(sqlLine, "(") + 1
endPos = InStr(sqlLine, ") values")
ExtractColumnNames = Trim(Mid(sqlLine, startPos, endPos - startPos))
End Function
Sub InsertColumnNames(sht As Worksheet, columnNames As String)
Dim columns As Variant
columns = Split(columnNames, ",")
With sht
Dim i As Integer
For i = LBound(columns) To UBound(columns)
.Cells(1, i + 1).Value = Trim(columns(i))
Next i
End With
End Sub
Sub InsertDataIntoSheet(sht As Worksheet, ByVal sqlLine As String) ' 明确指定参数类型
Dim valuesStartPos As Integer
Dim valuesEndPos As Integer
Dim values As String
Dim data As Variant
valuesStartPos = InStr(sqlLine, "values (") + Len("values (")
valuesEndPos = InStr(valuesStartPos, sqlLine, ");")
values = Mid(sqlLine, valuesStartPos, valuesEndPos - valuesStartPos)
data = Split(values, ",")
' 去掉单引号并插入数据到工作表中
With sht
Dim nextRow As Long
nextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Dim i As Integer
For i = LBound(data) To UBound(data)
.Cells(nextRow, i + 1).Value = Replace(Trim(data(i)), "'", "")
Next i
End With
End Sub
🍀
bonne nuit
paix
allez