ช่วยแก้โค้ดให้หน่อยครับ ดึงข้อมูลมาไม่ครบ

[Godtheking]

ผมดึงข้อมูลจากหลายๆ Sheets ทีเดียวครับแต่ระบบดึงข้อมูลมาไม่ครบครับมันขาดหายบ้างเป็นบางครั้งบางครั้งก็ไม่หายไม่รู้เป็นเพราะอะไรครับ ช่วง 720 กว่า ข้อมูลขาดหายไปบางช่วงแต่ 830 กว่า ข้อมูลมาครบปกติครับ โค้ดไม่มีติดครับ ช่วยดูให้หน่อยครับ

[snasui]

กรุณาแจ้งลำดับการทดสอบเพื่อให้พบปัญหานั้นมาทีละลำดับว่าต้องดำเนินการเช่นไรบ้าง คลิกปุ่มใด คีย์ค่าใด ในที่ใด ฯลฯ ครับ

[Godtheking]

ขั้นตอนแรกให้กด Start จะมี Userform ขึ้นให้ใส่ที่อยู่ของ ไฟล์ Excel ที่ต้องดึงข้อมูลทั้งหมดทีเดี่ยว เช่นของผม ให้ Copy ที่อยู่มาใส่ใน Userform และกด Register ครับ

[snasui]

แนบไฟล์ตัวอย่างที่ใช้เป็นข้อมูลมาด้วยจะได้ช่วยทดสอบได้ครับ

[Godtheking]

ไฟล์ใช้เยอะครับผมไม่รู้ว่าไฟล์ตัวไหนมีที่ปัญหา

[Godtheking]

อันนี้อีกส่วนครับที่เหลือไฟล์ใหญ่ไปส่งให้ไม่ได้

[snasui]

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

Code: Select all

Private Sub CommandButton1_Click()
    Dim lr As Long, lc As Long
    Dim sh As Worksheet, wb As Workbook
    Dim fileName As String, dataPath As String
    Dim tgSh As Worksheet, tl As Long
    
    Set tgSh = ThisWorkbook.Worksheets(1)
    If TextBox1.Value = "" Then
         MsgBox "**Input some value**"
         TextBox1.SetFocus
         Exit Sub
    End If
    dataPath = (TextBox1.Value) & "\"
    fileName = Dir(dataPath & "*.xlsx")
        Unload Me
    masRow = 1
    '-------- Loop open file -------------
    tl = 0
    Do While fileName <> ""
        'Open workbook
        Set wb = Workbooks.Open(fileName:=dataPath & fileName, ReadOnly:=True)

        '---------------------Loop sheet --------------------------------------
        For Each sh In wb.Sheets
            sh.Columns.EntireColumn.Hidden = False
            sh.Rows.EntireRow.Hidden = False
            If sh.FilterMode = True Then
                sh.ShowAllData
            End If
            With sh
                lr = .Range("i" & .Rows.Count).End(xlUp).Row
                lc = .Cells(5, .Columns.Count).End(xlToLeft).Column
            End With
            tgSh.Range("a1").Offset(tl, 0).Resize(lr, lc).Value = _
                sh.Range("a1").Resize(lr, lc).Value
            tl = tl + lr
        Next sh

        wb.Close False

        ' Call dir again ..
        fileName = Dir()
    Loop

End Sub

[Godtheking]

ขอบคุณครับได้แล้วครับ