EXCEL VBA将值分配给多个可变参数
您好我想插入一个值从Excel到MySQL数据库。 所以我的价值观在一排。 每行约20+个单元。 并且每个单元必须被input到数据库中的特定列。
我需要的是我所拥有的简化代码。
SQLStr = "INSERT INTO submitteddrawings(Team,Name,MgtNo,JobNo,DrawingNo,Status,Version,SubMo,DwgSheet,ReusedDwg,PCChecked, N1A,N1B,N1C,N1D,N2A,N2B,N2C,N2D,N3A,N3B,N3C,N3D,N3E,N4A,N4B,N4C,N4D,N4E,N5A,N5B,N5C,N5D,N6,J1A,J1B,J1C,J2A,J2B,J2C,J2D,J2E,J3A,J3B,J3C,J3D,J3E,J3F,J3G) VALUES ('" & e & "', '" & f & "','" & g & "','" & h & "','" & i & "','" & j & "','" & k & "','" & l & "','" & m & "','" & n & "','" & o & "','" & p & "','" & q & "','" & r & "','" & s & "','" & t & "','" & u & "','" & v & "','" & w & "','" & x & "','" & y & "','" & z & "','" & aa & "','" & ab & "','" & ac & "','" & ad & "','" & ae & "','" & af & "','" & ag & "','" & ah & "','" & ai & "','" & aj & "', '" & ak & "','" & al & "','" & am & "','" & an & "','" & ao & "','" & ap & "','" & aq & "','" & ar & "','" & ass & "','" & at & "','" & au & "','" & av & "','" & aw & "','" & ax & "','" & ay & "','" & az & "','" & ba & "','" & bb & "','" & bc & "','" & bd & "')" 正如所看到的，有很多和眼睛刺激的variables。 TIA
尝试了解下面的内容 – 为一行中的特定范围创build一个string。 这只是许多方法来实现在Excel中为特定范围生成SQL语句。
Option Explicit Private Function GetInsertStatementForRowRange(InputRange As Range) As String Dim SQLStr As String, sValues As String, oRng As Range Const INSERT_BASE As String = "INSERT INTO submitteddrawings(Team,Name,MgtNo,JobNo,DrawingNo,Status,Version,SubMo,DwgSheet,ReusedDwg,PCChecked,N1A,N1B,N1C,N1D,N2A,N2B,N2C,N2D,N3A,N3B,N3C,N3D,N3E,N4A,N4B,N4C,N4D,N4E,N5A,N5B,N5C,N5D,N6,J1A,J1B,J1C,J2A,J2B,J2C,J2D,J2E,J3A,J3B,J3C,J3D,J3E,J3F,J3G) VALUES (<VALUES>)" sValues = "" For Each oRng In InputRange.Cells If Len(sValues) > 0 Then sValues = sValues & ", " sValues = sValues & "'" & oRng.Value & "'" Next SQLStr = Replace(INSERT_BASE, "<VALUES>", sValues) GetInsertStatementForRowRange = SQLStr End Function Sub SO45427529() Dim lRow As Long Const COLS_BASE As String = "E<R>:BD<R>" ' Below example is just for columns E to BD on row 2 of ActiveSheet ' You need to modify the Do-Loop to suit your useful range, assuming stop when it's empty lRow = 7 ' Start from row 7 Do Until IsEmpty(Cells(lRow, "E")) ' Observe the output in Immediate Window Debug.Print "Row " & lRow, GetInsertStatementForRowRange(Range(Replace(COLS_BASE, "<R>", lRow))) lRow = lRow + 1 Loop End Sub
以下是如何创build函数来包装值的两个示例。
例1：
将行的值转换为1维数组，并使用Join创build一个包装各个值的string
Function getSingleQuotedValues(Target As Range) Dim Data As Variant Data = Application.WorksheetFunction.Transpose(Target.Value) Data = Application.WorksheetFunction.Transpose(Data) getSingleQuotedValues = "'" & Join(Data, "','") & "'" End Function
示例2 MYSQL：
这将使您在使用Select Case语句处理值时更灵活，以决定如何格式化各个列的数据。
产量
'1/2/2009 6:17:00 AM','Product1','1200','Mastercard','carolina','Basildon','England','United Kingdom','1/2/2009 6:00:00 AM','1/2/2009 6:08:00 AM','51.5','-1.1166667','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33','34','35','36','37','38','39','40','41','42','43','44','45','46','47','48','49','50','51','52','53','54','55','56'
Function getMySQLValues(Target As Range) As String Dim r As Range Dim s As String For Each r In Target Select Case r.Column Case 1, 9, 10 s = s & ",'" & Format(r.Value, "YYYYMMDDHHMMSS") & "'" 'Columns containing Date values Case Else s = s & ",'" & r.Value & "'" End Select Next getMySQLValues = Right(s, Len(s) - 1) End Function
奖金获取访问值string：
产量
#20090102061700#,'Product1',1200,'Mastercard','carolina','Basildon','England','United Kingdom',#20090102060000#,#20090102060800#,51.5,-1.1166667,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56
Function getAccessValues(Target As Range) As String Dim r As Range Dim s As String For Each r In Target Select Case r.Column Case 2, 4 To 8 'Columns containing String values s = s & ",'" & r.Value & "'" Case 1, 9, 10 s = s & ",#" & Format(r.Value, "yyyy-mm-dd hh:nn:ss") & "#" 'Columns containing Date values Case Else 'Columns containing Numeric values s = s & "," & r.Value End Select Next getAccessValues = Right(s, Len(s) - 1) End Function
testing
Sub Test() Dim x As Long With Worksheets("Data") Debug.Print "Test getSingleQuotedValues" For x = 2 To 5 Debug.Print getSingleQuotedValues(.Cells(x, 1).EntireRow.Range("A1:BD1")) Next Debug.Print vbCrLf & "Test getAccessValues" For x = 2 To 5 Debug.Print getAccessValues(.Cells(x, 1).EntireRow.Range("A1:BD1")) Next Debug.Print vbCrLf & "Test getMySQLValues" For x = 2 To 5 Debug.Print getMySQLValues(.Cells(x, 1).EntireRow.Range("A1:BD1")) Next End With End Sub