EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)ค่อย ๆ ถามตอบกันไปครับ
เก็บตามที่ผมแจ้งไปครับ
ส่วนใดที่ไม่เกี่ยวกับการนำข้อมูลไปวางในปลายทางจะต้องไม่รวมเข้าไปในพื้นที่นั้น ไม่ว่าจะเป็นเรื่อง Time Stamp หรืออื่นใดก็ตาม เพื่อให้ง่าย ข้อมูลปลายทางมีกี่คอลัมน์ให้ Copy หัวคอลัมน์มาใช้เลย ส่วนข้อมูลก็ Link จากไฟล์ปัจจุบันไปวางในตรงตำแหน่งคอลัมน์นั้น ๆ พื้นที่นี้กับด้านล่างต้องเป็นพื้นที่เดียวกัน
ได้ปรับตามที่ผมแจ้งไปแล้วหรือไม่ครับ
Code ที่ผมตอบไปจะนำข้อมูลที่วางไว้เป็นระเบียบแล้วส่งไป Insert ในไฟล์เป้าหมายที่ปิดอยู่ครับ
> คำอธิบายนี้ไม่ค่อยเข้าใจครับข้อมูลปลายทางมีกี่คอลัมน์ให้ Copy หัวคอลัมน์มาใช้เลย ส่วนข้อมูลก็ Link จากไฟล์ปัจจุบันไปวางในตรงตำแหน่งคอลัมน์นั้น ๆ พื้นที่นี้กับด้านล่างต้องเป็นพื้นที่เดียวกัน
[Sheet1$I1:N4]
Code: Select all
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$A2:CR100000]"
Code: Select all
Sub SaveData()
Dim sFile As String, sh As Worksheet
Dim sCnstr As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String, shtName As String
Dim arr() As Variant, i As Integer, j As Integer
sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
shtName = "[Data$]"
strSql = "INSERT INTO [sFile$]" & _
" SELECT * FROM [Excel 12.0 Macro;HDR=Yes;" & _
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$A2:CR100000]" & _
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$HN,Data$Name,Data$DOB,Data$Payer] value [Sheets(1).(""InputHN"").value,Sheets(1).(""InputName"").value,Sheets(1).(""C12"").value,Sheets(1).(""InputPayer"").value]"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
Set sCnstr = Nothing
Set rs = Nothing
End Sub
งานนี้เป็นการนำค่าไป Insert ในไฟล์ปลายทาง คำว่าข้อมูลปลายทางคือไฟล์ปลายทางครับwisitsakbenz wrote: ↑Fri Dec 02, 2022 1:35 pm ข้อมูลปลายทางมีกี่คอลัมน์ให้ Copy หัวคอลัมน์มาใช้เลย ส่วนข้อมูลก็ Link จากไฟล์ปัจจุบันไปวางในตรงตำแหน่งคอลัมน์นั้น ๆ พื้นที่นี้กับด้านล่างต้องเป็นพื้นที่เดียวกัน
> คำอธิบายนี้ไม่ค่อยเข้าใจครับ
ปรับยังไม่ถูกครับwisitsakbenz wrote: ↑Fri Dec 02, 2022 1:35 pm > ได้ปรับแล้วตามนี้
CODE: SELECT ALL
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$A2:CR100000]"
Code: Select all
INSERT INTO table_name (column1, column2, column3, ...)
VALUES (value1, value2, value3, ...);
Code: Select all
'----other Code-----
strSql = "INSERT INTO [sFile$]" & _
" SELECT * FROM [Excel 12.0 Macro;HDR=Yes;" & _
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$A1:CR2]" & _
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Data$HN,Data$Name,Data$DOB,Data$Payer] values [Sheets(1).(""InputHN"").value,Sheets(1).(""InputName"").value,Sheets(1).(""C12"").value,Sheets(1).(""InputPayer"").value]"
sCnstr.CursorLocation = adUseClient
'----other Code-----
Code: Select all
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Input$A6:H22]"
Code: Select all
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Input$A26:CR27]"
Code: Select all
Sub SaveData()
Dim sFile As String, sh As Worksheet
Dim sCnstr As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String, shtName As String
Dim arr() As Variant, i As Integer, j As Integer
sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
shtName = "[Data$]"
strSql = "INSERT INTO [sFile$]" & _
" SELECT * FROM [Excel 12.0 Macro;HDR=Yes;" & _
" Database=" & ThisWorkbook.FullName & ";Readonly=False].[Input$A26:CR27]"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
Set sCnstr = Nothing
Set rs = Nothing
End Sub
Code: Select all
Sub Savetofile_Click()
Dim r As Integer
Dim i As Integer
i = 1
r = Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("input").Cells(r, 2).Value = Day(Date)
Sheets("input").Cells(r, 3).Value = Month(Date)
Sheets("input").Cells(r, 4).Value = Year(Date) - 2000
Sheets("input").Cells(r, 5).Value = i
i = i + 1
Sheets("input").Cells(r, 2).NumberFormat = "00"
Sheets("input").Cells(r, 3).NumberFormat = "00"
Sheets("input").Cells(r, 5).NumberFormat = "0000"
Refno = Sheets("input").Cells(r, 4).Text & "-" & Sheets("input").Cells(r, 3).Text & "-" & Sheets("input").Cells(r, 2).Text & "-" & Sheets("input").Cells(r, 5).Text
Sheets("input").Cells(r, 1).Value = Refno
Sheets("Input").Range("InputRefNo") = Refno
Sheets("input").Cells(r, 6).Value = Sheets("Input").Range("InputName").Value
Sheets("input").Cells(r, 7).Value = Sheets("Input").Range("InputHN").Value
Sheets("input").Cells(r, 8).Value = Sheets("Input").Range("C12").Value
Sheets("input").Cells(r, 9).Value = Sheets("Input").Range("InputPayer").Value
Sheets("Input").Range("InputEstimateDateTime").Value = Now
Sheets("input").Cells(r, 95).Value = Sheets("Input").Range("InputEstimateDateTime").Value
End Sub
[Code]
[Data$]
rs.open sql...
ควรเป็น rs.open strsql...
Code: Select all
Sub Savetofile_Click()
Dim r As Integer
Dim i As Integer
i = 1
r = Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("input").Cells(r, 2).Value = Day(Date)
Sheets("input").Cells(r, 3).Value = Month(Date)
Sheets("input").Cells(r, 4).Value = Year(Date) - 2000
Sheets("input").Cells(r, 5).Value = i
i = i + 1
Sheets("input").Cells(r, 2).NumberFormat = "00"
Sheets("input").Cells(r, 3).NumberFormat = "00"
Sheets("input").Cells(r, 5).NumberFormat = "0000"
Refno = Sheets("input").Cells(r, 4).Text & "-" & Sheets("input").Cells(r, 3).Text & "-" & Sheets("input").Cells(r, 2).Text & "-" & Sheets("input").Cells(r, 5).Text
Sheets("input").Cells(r, 1).Value = Refno
Sheets("Input").Range("InputRefNo") = Refno
Sheets("input").Cells(r, 6).Value = Sheets("Input").Range("InputName").Value
Sheets("input").Cells(r, 7).Value = Sheets("Input").Range("InputHN").Value
Sheets("input").Cells(r, 8).Value = Sheets("Input").Range("C12").Value
Sheets("input").Cells(r, 9).Value = Sheets("Input").Range("InputPayer").Value
Sheets("Input").Range("InputEstimateDateTime").Value = Now
Sheets("input").Cells(r, 95).Value = Sheets("Input").Range("InputEstimateDateTime").Value
End Sub
ดึงค่านี้ออกมาให้ได้ก่อน ดึงมาแล้วจะเก็บไว้ในเซลล์หรือในตัวแปรก็แล้วแต่สะดวกครับwisitsakbenz wrote: ↑Sat Dec 03, 2022 12:36 pm 3. ตรวจสอบเลข RefNo ใน All Data Estimated > Column "A" เรียงต่อจากเลขเดิม
Code: Select all
Sub Savetofile_Click()
Dim sFile As String, sh As Worksheet
Dim sCnstr As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String, shtName As String
Dim arr() As Variant, i As Integer, j As Integer
sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
shtName = "[Data$]"
sql = "select * from " & shtName & " ' Order By 'RefNo' DESC LIMIT 1"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
myReader = sql.ExecuteReader();
while (myReader.Read())
{
Worksheets("input").Range("L22").Value = (myReader["RefNo"].ToString());
}
Set sCnstr = Nothing
Set rs = Nothing
Code: Select all
'Other code...
sql = "select top 1 * from " & shtName & " Order By [RefNo] DESC"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
MsgBox rs.Fields(0).Value
' myReader = sql.ExecuteReader();
' While (myReader.Read())
' {
' Worksheets("input").Range("L22").Value = (myReader["RefNo"].ToString());
' }
Set sCnstr = Nothing
'Other code...
Code: Select all
'Other code...
r = Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("input").Cells(r, 2).Value = Day(Date)
Sheets("input").Cells(r, 3).Value = Month(Date)
Sheets("input").Cells(r, 4).Value = Year(Date) - 2000
Sheets("input").Cells(r, 5).Value = rs.Fields(4).Value + 1
Sheets("input").Cells(r, 2).NumberFormat = "00"
Sheets("input").Cells(r, 3).NumberFormat = "00"
Sheets("input").Cells(r, 5).NumberFormat = "0000"
Refno = Sheets("input").Cells(r, 4).Text & "-" & Sheets("input").Cells(r, 3).Text & "-" & Sheets("input").Cells(r, 2).Text & "-" & Sheets("input").Cells(r, 5).Text
Sheets("input").Cells(r, 1).Value = Refno
Sheets("Input").Range("InputRefNo") = Refno
'Other code...
Code: Select all
'Other code...
With Sheets("input")
r = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(r, 2).Value = Day(Date)
.Cells(r, 3).Value = Month(Date)
.Cells(r, 4).Value = Year(Date) - 2000
.Cells(r, 2).NumberFormat = "00"
.Cells(r, 3).NumberFormat = "00"
.Cells(r, 5).NumberFormat = "0000"
refno = .Cells(r, 4).Text & "-" & .Cells(r, 3).Text & "-" & .Cells(r, 2).Text
If VBA.Left(rs.Fields(0).Value, 8) = refno Then
.Cells(r, 5).Value = rs.Fields(4).Value + 1
Else
.Cells(r, 5).Value = 1
End If
refno = refno & "-" & VBA.Format(.Cells(r, 5).Value, "0000")
.Cells(r, 1).Value = refno
.Range("InputRefNo") = refno
End With
'Other code
With...End With
เพื่อเขียน Code ได้สั้นลงครับsql = "select top 1 * from " & shtName & " Order By [Number] DESC"
หมายถึง คอลัมน์ Number จะต้องมีการเรียงจากน้อยไปหามากเท่านั้น ปกติเราจะใช้ Id ของรายการมาหารายการสุดท้าย เพราะ Id จะเรียงจากน้อยไปหามากเสมอ ไม่ใช่ Number ของงานนี้ที่ขึ้นกับวันที่ครับขอบคุณสำหรับคำแนะนำครับ และอยากสอบถามอาจารย์เพิ่มเติมครับกรุณาสังเกตการใช้With...End With
เพื่อเขียน Code ได้สั้นลงครับ
Code: Select all
Sub DataReview(ByVal GoToRow As Integer)
Dim sFile As String, sh As Worksheet
Dim sCnstr As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String, shtName As String
Dim arr() As Variant, i As Integer, j As Integer, k As Integer
Dim strS As String
sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
shtName = "[Data$]"
sql = "select * from " & shtName & " Order By [RefNo] DESC"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
With Sheets("input")
.Range("InputRefNo") = rs.Fields(GoToRow, 0).Value
.Range("InputName") = rs.Fields(GoToRow, 5).Value
.Range("InputHN").Value = rs.Fields(GoToRow, 6).Value
.Range("C12").Value = rs.Fields(GoToRow, 7).Value
.Range("InputPayer").Value = rs.Fields(GoToRow, 8).Value
.Range("InputEstimateDateTime").Value = rs.Fields(GoToRow, 94).Value
End With
Set sCnstr = Nothing
End Sub
Sub PreviousData()
Dim GoToRow As Integer
Dim sFile As String, sh As Worksheet
Dim sCnstr As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String, shtName As String
Dim arr() As Variant, i As Integer, j As Integer, k As Integer
Dim strS As String
sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
shtName = "[Data$]"
sql = "select * from " & shtName & " Order By [RefNo] DESC"
sCnstr.CursorLocation = adUseClient
sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & sFile & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, sCnstr
If Worksheets("Input").Range("InputRow") = "" Then
GoToRow = rs.Fields.Range("A1000000").End(xlUp).Row
Else
GoToRow = rs.Fields.Range("InputRow").Value - 1
End If
Worksheets("Input").Range("InputRow").Value = GoToRow
DataReview (GoToRow)
End Sub