:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup:

:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

ค้นหาข้อมูลจากอีก Sheet

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

ค้นหาข้อมูลจากอีก Sheet

#1

Post by wisitsakbenz »

เรียน อาจารย์

1. ต้องการค้นหาข้อมูลจากอีก Sheet แล้วมาแสดง
ถ้าอยากให้ค้นหาโดยที่ไม่ต้องเปิดไฟล์ที่ต้องการค้นหา จะต้องปรับ Code อย่างไรครับ หรืออาจารย์พอมีวิธีอื่นหรือไม่ครับ
(Data ประมาณ 20กว่า M ครับ)

ไฟล์ : Pre-Arrangement1 - Copy อยู่ในเครื่อง
ไฟล์ : All Data Estimated อยู่ที่ Server ครับ

Code: Select all

Private Sub CommandButton2_Click()
Dim sb As Workbook
Dim sh As Worksheet
Dim rngA As Range
Dim r As Range
Dim strSb As String
Dim Ref As String
Dim f As Boolean
strSb = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
Set sb = Workbooks.Open(Filename:=strSb, UpdateLinks:=False, ReadOnly:=True)
f = False
With ThisWorkbook.Worksheets("Input")
    Ref = .Range("F6").Value
    For Each sh In sb.Worksheets
        Set rngA = sh.Range("a2", sh.Range("a" & sh.Rows.Count).End(xlUp))
        For Each r In rngA
            If r.Value = Ref Then
                .Range("C10").Value = r.Offset(0, 6).Value
                .Range("F10").Value = r.Offset(0, 5).Value
                .Range("C12").Value = r.Offset(0, 7).Value
                .Range("C14").Value = r.Offset(0, 12).Value
                 .Range("C16").Value = r.Offset(0, 11).Value
                 .Range("C18").Value = r.Offset(0, 16).Value
                .Range("C20").Value = r.Offset(0, 20).Value
                .Range("C22").Value = r.Offset(0, 22).Value
                .Range("E22").Value = r.Offset(0, 23).Value
                f = True
                Exit For
            End If
        Next r
        If f Then Exit For
    Next sh
End With
sb.Close False
End Sub
2.ต้องการ Search HN โดยค้นหาที่เดียวกันกับข้อ 1 ให้มาแสดงใน ListBox ยัง error อยู่
จะต้องปรับ Code อย่างไรครับ

Code: Select all

 
Private Sub CommandButton1_Click()

Dim sb As Workbook
Dim sh As Worksheet
Dim rngA As Range
Dim r As Range
Dim strSb As String
Dim Ref As String
Dim f As Boolean
strSb = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
Set sb = Workbooks.Open(Filename:=strSb, UpdateLinks:=False, ReadOnly:=False)
f = False

'Other code
Dim i As Long, j As Long
Dim arr(0, 26) As Variant
Me.ListBox1.Clear
Me.ListBox1.AddItem
For a = 0 To 26
    arr(0, a) = sh.Cells(1, a + 1).Value
'    Me.ListBox1.List(0, a - 1) = Sheet1.Cells(1, a)
Next a
Me.ListBox1.ColumnCount = 26
Me.ListBox1.List = arr
'Me.ListBox1.Locked = True
ListBox1.ColumnWidths = "25 ,0 ,0 ,0,0 ,64 ,0 ,68 ,60,25, 25,70 ,70 ,0 ,0 ,0 ,0,80,0 ,0 ,0 ,0 ,0 ,0 ,0, 50"
ListBox1.Height = 170
ListBox1.Width = 550
ListBox1.Left = 764
ListBox1.Top = 282
'Other code
    'For List Box fill
    'For i = 2 To Sheet4.Range("A1000000").End(xlUp).Row
   
     For i = sh.Range("A1000000").End(xlUp).Row To 2 Step -1
        If sb.Cells(i, 7).Value = TextBox1.Value Then
            Me.ListBox1.AddItem
            For x = 1 To 26
                Me.ListBox1.List(ListBox1.ListCount - 1, x - 1) = sh.Cells(i, x)
            Next x
        End If
    Next i


ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#2

Post by snasui »

:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub CommandButton1_Click()

    Dim sb As Workbook
    Dim sh As Worksheet
    Dim rngA As Range
    Dim r As Range
    Dim strSb As String
    Dim Ref As String
    Dim f As Boolean
    strSb = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    Set sb = Workbooks.Open(Filename:=strSb, UpdateLinks:=False, ReadOnly:=False)
    Set sh = sb.Worksheets("Data")
    f = False
    
    'Other code
    Dim i As Long, j As Long
    Dim b As Variant
    Dim arr(0, 26) As Variant
    Me.ListBox1.Clear
    Me.ListBox1.AddItem
    
    ReDim b(sh.Range("A1000000").End(xlUp).Row, 26)
    'For i = sh.Range("A1000000").End(xlUp).Row To 2 Step -1
    For i = 0 To UBound(b)
        For a = 0 To 26
            b(i, a) = sh.Cells(i + 2, a + 1).Value
            Debug.Print sh.Cells(i + 2, a + 1).Address
        '    Me.ListBox1.List(0, a - 1) = Sheet1.Cells(1, a)
        Next a
    Next i
    Me.ListBox1.ColumnCount = 26
    Me.ListBox1.List = b
    'Me.ListBox1.Locked = True
    ListBox1.ColumnWidths = "25 ,0 ,0 ,0,0 ,64 ,0 ,68 ,60,25, 25,70 ,70 ,0 ,0 ,0 ,0,80,0 ,0 ,0 ,0 ,0 ,0 ,0, 50"
    ListBox1.Height = 170
    ListBox1.Width = 550
    ListBox1.Left = 764
    ListBox1.Top = 282
    'Other code
        'For List Box fill
        'For i = 2 To Sheet4.Range("A1000000").End(xlUp).Row
       
    '        If sb.Cells(i, 7).Value = TextBox1.Value Then
    '            Me.ListBox1.AddItem
    '            For x = 1 To 26
    '                Me.ListBox1.List(ListBox1.ListCount - 1, x - 1) = sh.Cells(i, x)
    '            Next x
    '        End If

End Sub
กรณีต้องการนำข้อมูลจากไฟล์ที่ปิดอยูมาใช้งานลองดูตัวอย่าง Code จากโพสต์นี้ครับ viewtopic.php?t=19553#p113919

ลองดัดแปลงแก้ไขให้เข้ากับงานของตัวเอง ติดตรงไหนค่อยนำมาถามกันต่อครับ
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#3

Post by wisitsakbenz »

เรียน อาจารย์

ทางผมลองทำดูแล้ว แต่ยังติดปัญหาอยู่ ไม่ค่อยเข้าใจ Code เท่าไหร่ แต่พยายามปรับเปลี่ยน หรือศึกษาแล้ว
ข้อมูลที่ต้องการไม่แสดงใน Lixtbox
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub sample2()

    Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "\\10.21.4.97\File Sharing2\DataPricing\"
    
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder2 FileSystem.GetFolder(HostFolder)
    
End Sub


Sub DoFolder2(Folder)
    Dim SubFolder
    Dim File
    Dim n As Long
    Dim n2 As Long
    Dim sh As Worksheet
    Dim tws As Workbook
    
    Dim i As Long, j As Long
    Dim b As Variant
    Dim arr(0, 26) As Variant
      
    For Each File In Folder.Files
        If File.Name = "All Data Estimated" Then
    ListBox1.Clear
   ListBox1.AddItem
    
    ReDim b(sh.Range("A1000000").End(xlUp).Row, 26)
    For i = 0 To UBound(b)
        For a = 0 To 26
            b(i, a) = sh.Cells(i + 2, a + 1).Value
            Debug.Print sh.Cells(i + 2, a + 1).Address
        Next a
    Next i
    
            Call GetSheetname(theFullName:=File)
        End If
    Next
End Sub

Sub ImportFile(sFile As String, sh As String)
    Dim sCnstr As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String, shtName As String
    On Error Resume Next
    shtName = "[" & VBA.Replace(sh, "'", "") & "]"
    sql = "select * from " & shtName
    sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
        & "Data Source=" & sFile & ";" _
        & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    rs.Open sql, sCnstr
    With Worksheets("data")
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
            .CopyFromRecordset rs
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub


Function GetSheetname(ByVal theFullName As String) As String
    Dim cn As ADODB.Connection
    Dim rsT As ADODB.Recordset
    Dim intTblCnt As Integer
    Dim strTbl As String
    Dim t As Integer
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
      '  & "Data Source=" & theFullName & ";" _
      '  & "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"

    Set rsT = cn.OpenSchema(adSchemaTables)
    intTblCnt = rsT.RecordCount

    Do While Not rsT.EOF
        strTbl = rsT.Fields("TABLE_NAME").Value
        If Right(strTbl, 2) = "$'" And VBA.Left(strTbl, 11) = "'COST SHEET" Then
           Call ImportFile(sFile:=theFullName, sh:=strTbl)
        End If
        rsT.MoveNext
    Loop
    rsT.Close
    cn.Close
End Function

You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#4

Post by snasui »

:D ตัวอย่าง Code สำหรับการดึงข้อมูลจากไฟล์ต้นทางที่ปิดอยู่เพื่อนำค่ามาใส่ ListBox ลองปรับใช้ดูครับ

Code: Select all

Sub ImportData()
    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
    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 Worksheets("input")
        .ListBox1.Clear
        .ListBox1.AddItem
        ReDim arr(rs.RecordCount, 26)
        Do While Not rs.EOF
            For i = 0 To 26
                arr(j, i) = rs.Fields(i).Value
            Next i
            j = j + 1
            rs.MoveNext
        Loop
        .ListBox1.List = arr
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#5

Post by wisitsakbenz »

เรียน อาจารย์ Snasui

ขอโทษอาจารย์ที่ตอบช้าครับ
1.อยากให้ข้อมูลใน Listbox เรียงจาก Ref มากไปน้อย ต้องปรับ Code อย่างไรครับ
2.ในกรณีที่ Save ข้อมูลในที่เดียวกันโดยไม่เปิดไฟล์ ผมได้ลองเขียน Code แล้ว แต่ยังติดปัญหาอยู่
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub SaveData()

ColName = 6
 ColHN = 7
ColDOB = 8
ColPayer = 9
ColNation = 10

    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
    Dim WI As Worksheet
    
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    shtName = "[Data$]"
    sql = "select * from " & shtName
    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 WI = Worksheets("Input")
    Set WD = rs.Worksheets("Data")
    
    'Find the next empty row
    Dim lastrow As Long
    Dim NewRow As Long
    Dim LastRowDate As Long
    Dim NewRowDate As Long
    
    lastrow = WD.Range("A1000000").End(xlUp).Row
    NewRow = lastrow + 1
    
'Create reference number
    WD.Cells(NewRow, 2).Value = Day(Date)
    WD.Cells(NewRow, 3).Value = Month(Date)
    WD.Cells(NewRow, 4).Value = Year(Date) - 2000
    
    
    'Reference number reset to 1 on new date
    LastRowDate = WD.Cells(lastrow, 2).Value
    NewRowDate = WD.Cells(NewRow, 2).Value
    If LastRowDate <> NewRowDate Then
        WD.Cells(NewRow, 5).Value = 1
    Else
        WD.Cells(NewRow, 5).Value = WD.Cells(lastrow, 5) + 1
    End If
    
  
    'Format month, date, and reference number
    WD.Cells(NewRow, 3).NumberFormat = "00"
    WD.Cells(NewRow, 2).NumberFormat = "00"
    WD.Cells(NewRow, 5).NumberFormat = "0000"

    'Assign unique reference number in column 1
    RefNo = WD.Cells(NewRow, 4).Text & "-" & WD.Cells(NewRow, 3).Text & "-" & WD.Cells(NewRow, 2).Text & "-" & WD.Cells(NewRow, 5).Text
    WD.Cells(NewRow, 1).Value = RefNo
    
    
    'Assign RefNo back to Input page
    WI.Range("InputRefNo") = RefNo
    
    'Assign Date/Time
    WI.Range("InputEstimateDateTime") = Now
    
         WD.Cells(NewRow, ColName).Value = WI.Range("InputName")
    WD.Cells(NewRow, ColHN).Value = WI.Range("InputHN")
    WD.Cells(NewRow, ColDOB).Value = WI.Range("InputDOB")
    WD.Cells(NewRow, ColPayer).Value = WI.Range("InputPayer")
    WD.Cells(NewRow, ColNation).Value = WI.Range("InputNation")
    
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#6

Post by wisitsakbenz »

เรียน อาจารย์ Snasui

ติดปัญหาอีกอย่างคือ คลิก Search HN ข้อมูลจะแสดงทั้งหมด ไม่ได้แสดง HN ที่ค้นหา
ต้องปรับสูตรอย่างไรครับ

Code: Select all

Sub ImportData()
    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
    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 Worksheets("input")
     If rs.Cells(i, 7).Value = Sheet1.Cells(3, 15).Value Then
        .ListBox1.Clear
        .ListBox1.AddItem
        ReDim arr(rs.RecordCount, 26)
        Do While Not rs.EOF
            For i = 0 To 26
                arr(j, i) = rs.Fields(i).Value
            Next i
            j = j + 1
            rs.MoveNext
        Loop
        .ListBox1.List = arr
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#7

Post by snasui »

wisitsakbenz wrote: Mon Nov 28, 2022 10:50 am คลิก Search HN ข้อมูลจะแสดงทั้งหมด ไม่ได้แสดง HN ที่ค้นหา
:D เขียน Code ไว้ตรงไหนในเรื่องการ Search กรุณาแจ้งมาด้วยจะได้เข้าถึงปัญหาโดยไว ถ้ายังไม่เขียนกรุณาเขียนมาก่อนครับ
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#8

Post by wisitsakbenz »

เรียน อาจารย์ Snasui

ผมได้ปรับในส่วนนี้ แต่ยังติดอยู่ครับ
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all


'--------other code------------
    With Worksheets("input")
     If rs.Fields(7).Value = Sheet1.Cells(3, 15).Value Then
        .ListBox1.Clear
        .ListBox1.AddItem
        ReDim arr(rs.RecordCount, 26)
        Do While Not rs.EOF
            For i = 0 To 26
                arr(j, i) = rs.Fields(i).Value
            Next i
            j = j + 1
            rs.MoveNext
        Loop
        .ListBox1.List = arr
          End If
    End With
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#9

Post by snasui »

:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub ImportData()
    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
    Dim strS As String
    
    strS = Sheets(1).OLEObjects("TextBox1").Object.Text
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    shtName = "[Data$]"
    sql = "select * from " & shtName
    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 Worksheets("input")
'     If rs.Fields(7).Value = Sheet1.Cells(3, 15).Value Then
        .ListBox1.Clear
        .ListBox1.AddItem
        ReDim arr(rs.RecordCount, 26)
        Do While Not rs.EOF
            If rs.Fields(6).Value = "HN" Or rs.Fields(6).Value = strS Then
                For i = 0 To 26
                    arr(j, i) = rs.Fields(i).Value
                Next i
            End If
            j = j + 1
            rs.MoveNext
        Loop
        .ListBox1.List = arr
'          End If
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#10

Post by wisitsakbenz »

เรียน อาจารย์

หลังจากค้นหาแล้ว ผลลัพธ์ที่ได้จะเว้นบรรทัด
ถ้าไม่อยากให้มีการเว้นบรรทัด และอยากให้ผลลัพธ์แสดง Ref มากไปยังน้อย
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

           If rs.Fields(6).Value = "HN" Or rs.Fields(6).Value = strS Then
                For i = 0 To 26
                    arr(j, i) = rs.Fields(i).Value
                    
                  If arr(j, i) = "" Then
                  arr(j, i).EntireRow.Delete
                  End If
                  
                Next i
            End If
            j = j + 1
            rs.MoveNext
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#11

Post by snasui »

wisitsakbenz wrote: Wed Nov 30, 2022 11:01 am หลังจากค้นหาแล้ว ผลลัพธ์ที่ได้จะเว้นบรรทัด
:D นำ j = j + 1 ไปไว้บรรทัดล่างของ Next i ครับ
wisitsakbenz wrote: Wed Nov 30, 2022 11:01 am อยากให้ผลลัพธ์แสดง Ref มากไปยังน้อย
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ
คอลัมน์ไหนคือ Ref ครับ :?:
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#12

Post by wisitsakbenz »

เรียน อาจารย์ snasui

เช่นค้นหา HN : 11-18-048
อยากให้แสดงข้อมูล 21-01-01-003 ก่อน หรือข้อมูลล่าสุดของ HN นั้นๆ ก่อนครับ
ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#13

Post by snasui »

:D คำว่าล่าสุดอยู่ท้ายสุดใช่หรือไม่ครับหรือเรียงแบบไหน กรุณาให้รายละเอียดที่สามารถเข้าใจได้ด้วยครับ

กรณีต้องการเรียงจากน้อยไปหามากหรือมากไปหาน้อยสามารถเรียงจากต้นทาง หากเรียงใน ListBox จะค่อนข้างวุ้นวายพอสมควร ปกติสามารถเรียงด้วย Statement ของ SQL ได้ แต่กรณีนี้ไม่ง่ายที่จะใช้ SQL Statement ในการเรียง ยกเว้น Database คือ SQL เช่นนี้เป็นต้นครับ

ตัวอย่างการ Sort ใน ListBox https://stackoverflow.com/questions/623 ... ding-order

https://exceloffthegrid.com/sorting-listboxes-with-vba/

นอกจากนี้ยังสามารถนำข้อมูลมาวางในชีตใด ๆ แล้วค่อย Sort แล้วเก็บค่าหลัง Sort แล้วเข้าไปใน ListBox ซึ่งจะง่ายกว่าวิธีข้างบนครับ
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#14

Post by wisitsakbenz »

เรียน อาจารย์

-การเรียงข้อมูลจะลองทำตามอาจารย์แนะนำก่อนครับ และยังติดอีกปัญหาที่เคยโพสไปแล้วคือ
กรณีที่ Save ข้อมูลในที่เดียวกันโดยไม่เปิดไฟล์ ผมได้ลองเขียน Code แล้ว แต่ยังติดปัญหาอยู่
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub SaveData()

ColName = 6
 ColHN = 7
ColDOB = 8
ColPayer = 9
ColNation = 10

    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
    Dim WI As Worksheet
    
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    shtName = "[Data$]"
    sql = "select * from " & shtName
    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 WI = Worksheets("Input")
    Set WD = rs.Worksheets("Data")
    
    'Find the next empty row
    Dim lastrow As Long
    Dim NewRow As Long
    Dim LastRowDate As Long
    Dim NewRowDate As Long
    
    lastrow = WD.Range("A1000000").End(xlUp).Row
    NewRow = lastrow + 1
    
'Create reference number
    WD.Cells(NewRow, 2).Value = Day(Date)
    WD.Cells(NewRow, 3).Value = Month(Date)
    WD.Cells(NewRow, 4).Value = Year(Date) - 2000
    
    
    'Reference number reset to 1 on new date
    LastRowDate = WD.Cells(lastrow, 2).Value
    NewRowDate = WD.Cells(NewRow, 2).Value
    If LastRowDate <> NewRowDate Then
        WD.Cells(NewRow, 5).Value = 1
    Else
        WD.Cells(NewRow, 5).Value = WD.Cells(lastrow, 5) + 1
    End If
    
  
    'Format month, date, and reference number
    WD.Cells(NewRow, 3).NumberFormat = "00"
    WD.Cells(NewRow, 2).NumberFormat = "00"
    WD.Cells(NewRow, 5).NumberFormat = "0000"

    'Assign unique reference number in column 1
    RefNo = WD.Cells(NewRow, 4).Text & "-" & WD.Cells(NewRow, 3).Text & "-" & WD.Cells(NewRow, 2).Text & "-" & WD.Cells(NewRow, 5).Text
    WD.Cells(NewRow, 1).Value = RefNo
    
    
    'Assign RefNo back to Input page
    WI.Range("InputRefNo") = RefNo
    
    'Assign Date/Time
    WI.Range("InputEstimateDateTime") = Now
    
         WD.Cells(NewRow, ColName).Value = WI.Range("InputName")
    WD.Cells(NewRow, ColHN).Value = WI.Range("InputHN")
    WD.Cells(NewRow, ColDOB).Value = WI.Range("InputDOB")
    WD.Cells(NewRow, ColPayer).Value = WI.Range("InputPayer")
    WD.Cells(NewRow, ColNation).Value = WI.Range("InputNation")
    
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#15

Post by snasui »

:D ช่วยอธิบายว่า Save ข้อมูลไปที่เดียวโดยไม่เปิดไฟล์เป็นการ Save ไปที่ไหน ช่วยลำดับขั้นตอนการทำงานมาด้วย

Code ที่เขียนมานั้นเป็นการดึงข้อมูลมาแสดงไม่ใช่ Save กลับไป กรณีใช้ Statement SQL จะต้องมีคำว่า Update เพื่อ Update ข้อมูลเดิมหรือมีคำว่า Insert หากเป็นข้อมูลใหม่ ไม่ใช่เป็นคำว่า Select อยู่เช่นเดิมซึ่งหมายถึงการนำมาใช้งาน

ช่วยปรับ Code ให้เป็นการ Save อย่างที่กล่าวมาด้วยครับ
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#16

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ขอโทษอาจารย์ด้วยครับ
กรอกข้อมูลแล้ว คลิกปุ่ม Save ข้อมูลจะถูกบันทึกใน workbook > "All Data Estimated" , worksheet > "Data"
ซึ่งอยู่ที่ Path : \\10.21.4.97\File Sharing2\DataPricing
ขอบคุณครับ

Code: Select all

Sub SaveData()

ColName = 6
 ColHN = 7
ColDOB = 8
ColPayer = 9
ColNation = 10

    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
    Dim WI As Worksheet
    
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    shtName = "[Data$]"
    sql = "insert into " & shtName
    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 WI = Worksheets("Input")
    Set WD = rs.Worksheets("Data")
    
    'Find the next empty row
    Dim lastrow As Long
    Dim NewRow As Long
    Dim LastRowDate As Long
    Dim NewRowDate As Long
    
    lastrow = WD.Range("A1000000").End(xlUp).Row
    NewRow = lastrow + 1
    
'Create reference number
    WD.Cells(NewRow, 2).Value = Day(Date)
    WD.Cells(NewRow, 3).Value = Month(Date)
    WD.Cells(NewRow, 4).Value = Year(Date) - 2000
    
    
    'Reference number reset to 1 on new date
    LastRowDate = WD.Cells(lastrow, 2).Value
    NewRowDate = WD.Cells(NewRow, 2).Value
    If LastRowDate <> NewRowDate Then
        WD.Cells(NewRow, 5).Value = 1
    Else
        WD.Cells(NewRow, 5).Value = WD.Cells(lastrow, 5) + 1
    End If
    
  
    'Format month, date, and reference number
    WD.Cells(NewRow, 3).NumberFormat = "00"
    WD.Cells(NewRow, 2).NumberFormat = "00"
    WD.Cells(NewRow, 5).NumberFormat = "0000"

    'Assign unique reference number in column 1
    RefNo = WD.Cells(NewRow, 4).Text & "-" & WD.Cells(NewRow, 3).Text & "-" & WD.Cells(NewRow, 2).Text & "-" & WD.Cells(NewRow, 5).Text
    WD.Cells(NewRow, 1).Value = RefNo
    
    
    'Assign RefNo back to Input page
    WI.Range("InputRefNo") = RefNo
    
    'Assign Date/Time
    WI.Range("InputEstimateDateTime") = Now
    
         WD.Cells(NewRow, ColName).Value = WI.Range("InputName")
    WD.Cells(NewRow, ColHN).Value = WI.Range("InputHN")
    WD.Cells(NewRow, ColDOB).Value = WI.Range("InputDOB")
    WD.Cells(NewRow, ColPayer).Value = WI.Range("InputPayer")
    WD.Cells(NewRow, ColUsePackage).Value = WI.Range("InputUsePackage")
    WD.Cells(NewRow, ColNation).Value = WI.Range("InputNation")


    
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub

You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#17

Post by snasui »

:D ผมสังเกตไฟล์ All Data Estimated.xlsx บรรทัดแรกไม่ใช่หัวคอลัมน์ ให้ลบบรรทัดนั้นทิ้งไปเพราะมันจะไม่เป็น Database ทำให้เขียน SQL ยุ่งยากขึ้นกว่าเดิม เช่นต้องเพิ่ม Range ตามเข้ามาด้วย เช่นนี้เป็นต้น

จากนั้นใช้ Code ด้านล่างสำหรับการดึงข้อมูลตามเงื่อนไขและมีการเรียงให้แล้วตาม SQL Statement ใน Code ด้านล่าง

Code: Select all

Sub ImportData()
    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
    
    strS = Sheets(1).OLEObjects("TextBox1").Object.Text
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"

    shtName = "[Data$]"
    sql = "select * from " & shtName & " Where HN ='" & strS & " ' Order By 'RefNo'"
    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 Worksheets("input")
        .ListBox1.Clear
        .ListBox1.AddItem
        ReDim arr(rs.RecordCount, 26)
        Do While Not rs.EOF
            For i = 0 To 26
                If j = 0 Then
                    For k = 0 To 26
                        arr(j, k) = rs.Fields(k).Name
                    Next k
                    j = j + 1
                End If
                arr(j, i) = rs.Fields(i).Value
            Next i
            j = j + 1
            rs.MoveNext
        Loop
        .ListBox1.List = arr
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
ในการบ้นทึกกลับไปจะต้องตัดสินใจว่าบันทึกเพิ่มเข้าไปหรือว่าเป็นการ Update รายการเดิม มันต้องมี Where Clause ด้วยครับ นอกจากนี้หากบันทึกครั้งละหลายรายการจะต้อง Loop เข้าไปทีละรายการใส่เข้าที่ Statement Insert หรือ Update ครับ
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#18

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ตอบคำถามอาจารย์ครับ
snasui wrote: Wed Nov 30, 2022 4:10 pm ผมสังเกตไฟล์ All Data Estimated.xlsx บรรทัดแรกไม่ใช่หัวคอลัมน์ ให้ลบบรรทัดนั้นทิ้งไปเพราะมันจะไม่เป็น Database ทำให้เขียน SQL ยุ่งยากขึ้นกว่าเดิม เช่นต้องเพิ่ม Range ตามเข้ามาด้วย

ในการบ้นทึกกลับไปจะต้องตัดสินใจว่าบันทึกเพิ่มเข้าไปหรือว่าเป็นการ Update รายการเดิม มันต้องมี Where Clause ด้วยครับ นอกจากนี้หากบันทึกครั้งละหลายรายการจะต้อง Loop เข้าไปทีละรายการใส่เข้าที่ Statement Insert หรือ Update ครับ
-ลบบรรทัดแรกแล้ว ได้ผลตามต้องการแล้วครับ
-คลิก Save คือการบันทึกข้อมูลเข้าไปใน All Data Estimated.xlsx > sheet "Data" อย่างเดียว ไม่มีการ update ครับ

อยากสอบถามอาจารย์เพิ่มเติมครับ
กรอกข้อมูลที่ >Workbook "Pre-Arrangement1-Copy" sheet "input"

ช่อง F6 จะไม่ใส่ค่า ระบบจะ Generate ให้อัตโนมัติหลังจากที่คลิกปุ่ม Save
โดยกำหนด = ปี-เดือน-วัน-Running Number
โดยที่ปี = ปีปัจุบัน - 2000
เช่นปี 2022 เดือน พฤศจิกายน วันที่ 20
เลข Refno ที่ได้ = 22-11-20-0001

ช่อง C20 จะไม่ใส่ค่า ระบบจะ Generate ให้อัตโนมัติหลังจากที่คลิกปุ่ม Save จะเท่ากับ วันที่และเวลาขณะ Save format = "dd/mm/yy hh:mm"

เมื่อกรอกรายละเอียดครบแล้ว คลิกปุ่ม Save ข้อมูลจะถูกบันทึกใน \\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx
ทางผมลองเขียน Code แล้วแต่ยังติดปัญหาอยู่ ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub SaveData()

ColName = 6
 ColHN = 7
ColDOB = 8
ColPayer = 9
ColNation = 10

    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
    Dim WI As Worksheet
    
    sFile = "\\10.21.4.97\File Sharing2\DataPricing\All Data Estimated.xlsx"
    shtName = "[Data$]"
    sql = "insert  into  " & sFile
    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 WI = Worksheets("Input")
    Set OW = Workbooks("All Data Estimated.xlsx")
    Set WD = OW.Worksheets("Data")
    
    'Find the next empty row
    Dim lastrow As Long
    Dim NewRow As Long
    Dim LastRowDate As Long
    Dim NewRowDate As Long
    
    lastrow = WD.Range("A1000000").End(xlUp).Row
    NewRow = lastrow + 1
    
'Create reference number
    WD.Cells(NewRow, 2).Value = Day(Date)
    WD.Cells(NewRow, 3).Value = Month(Date)
    WD.Cells(NewRow, 4).Value = Year(Date) - 2000
    
    
    'Reference number reset to 1 on new date
    LastRowDate = WD.Cells(lastrow, 2).Value
    NewRowDate = WD.Cells(NewRow, 2).Value
    If LastRowDate <> NewRowDate Then
        WD.Cells(NewRow, 5).Value = 1
    Else
        WD.Cells(NewRow, 5).Value = WD.Cells(lastrow, 5) + 1
    End If
    
  
    'Format month, date, and reference number
    WD.Cells(NewRow, 3).NumberFormat = "00"
    WD.Cells(NewRow, 2).NumberFormat = "00"
    WD.Cells(NewRow, 5).NumberFormat = "0000"

    'Assign unique reference number in column 1
    Refno = WD.Cells(NewRow, 4).Text & "-" & WD.Cells(NewRow, 3).Text & "-" & WD.Cells(NewRow, 2).Text & "-" & WD.Cells(NewRow, 5).Text
    WD.Cells(NewRow, 1).Value = Refno
    
    
    'Assign RefNo back to Input page
    WI.Range("InputRefNo") = Refno
    
    'Assign Date/Time
    WI.Range("InputEstimateDateTime") = Now
    
         WD.Cells(NewRow, ColName).Value = WI.Range("InputName")
    WD.Cells(NewRow, ColHN).Value = WI.Range("InputHN")
    WD.Cells(NewRow, ColDOB).Value = WI.Range("InputDOB")
    WD.Cells(NewRow, ColPayer).Value = WI.Range("InputPayer")
    WD.Cells(NewRow, ColUsePackage).Value = WI.Range("InputUsePackage")
    WD.Cells(NewRow, ColNation).Value = WI.Range("InputNation")
    
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ค้นหาข้อมูลจากอีก Sheet

#19

Post by snasui »

:D Code ที่เขียนมาไม่ใช่ Code สำหรับการ Insert ข้อมูลเข้าไปในไฟล์ที่ปิด จะต้องศึกษาเกี่ยวกับการใช้ SQL Statement สำหรับการนำข้อมูลเข้าไปวางใน Database ให้เข้าใจเสียก่อน

วิธีการนำข้อมูลที่ไม่เป็นระเบียบเข้าไปวางในไฟล์ที่ปิดด้วย SQL Statement สามารถทำให้ง่ายลงด้วยการ Link ข้อมูลเหล่านั้นไปเรียงให้เป็น Record คล้ายกับข้อมูลปลายทาง โดยมีหัวคอลัมน์กำกับให้เรียบร้อย จากนั้นค่อยนำไปวางในไฟล์ปลายทางด้วย SQL Statement เช่น

Code: Select all

strSql = "INSERT INTO [Sheet1$]" & _
            " SELECT * FROM [Excel 12.0 Macro;HDR=Yes;" & _
            " Database=" & thisworkbook.fullname & ";Readonly=False].[Sheet1$I1:N4]"
จาก Sheet1$I1:N4 ใน Code หมายถึงพื้นที่จะวางข้อมูลไว้เป็นระเบียบพร้อมนำเข้าไปวางในไฟล์ปลายทางดังที่กล่าวไว้ข้างบนแล้ว เมื่อจะนำไปใช้งานจริงให้ปรับ Sheet1$ เป็นชื่อชีตที่ใช้จริง

ส่วน Code อื่นใดที่อยู่ด้านล่างบรรทัด rs.Open sql, sCnstr จากโพสต์ที่ 18 ไม่สามารถวางค่าในไฟล์ที่ปิดได้ด้วยวิธีการนี้ ลบทิ้งไปได้เลยยกเว้นด้านล่างครับ
Set sCnstr = Nothing
Set rs = Nothing
wisitsakbenz
Bronze
Bronze
Posts: 430
Joined: Mon Sep 09, 2019 3:13 pm
Excel Ver: 2013

Re: ค้นหาข้อมูลจากอีก Sheet

#20

Post by wisitsakbenz »

เรียน อาจารย์ snasui

ทำตามคำที่อาจารย์แนะนำแล้ว ไม่แน่ใจว่าถูกหรือไม่
และอยากสอบถามค่าที่กรอกในแต่ละช่อง จะมีการเก็บอย่างไรครับ
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

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 [Data$]" & _
            " SELECT * FROM [Excel 12.0 Macro;HDR=Yes;" & _
            " Database=" & ThisWorkbook.FullName & ";Readonly=False].[Sheet1$I1:N4]"

    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
You do not have the required permissions to view the files attached to this post.
Post Reply