ขออนุญาตสอบถามปัญหาการนำเข้า workbook อื่น มาได้ไม่ครบและเปลี่ยนชื่อ worksheets ด้วยชื่อ workbook ที่นำเข้าครับ

[9KiTTi]

ขออนุญาตสอบถามปัญหาการนำเข้า workbook อื่น มาได้ไม่ครบ เช่น ถ้าเลือกนำเข้า 10 ไฟล์ ก็จะนำเข้าได้แค่ 9 และไม่ว่าจะเลือกนำเข้าเท่าไหร่ ก็จะหายไป 1 ไฟล์เสมอครับ

Code: Select all

Sub im_money()
    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Set MstWbk = ThisWorkbook
    FNames = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="เลือกไฟล์ที่จะนำเข้าตรวจสอบ")
    If Not IsArray(FNames) Then Exit Sub
    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count) ' คัดลอกแผ่นงานไปท้ายสุด
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(1, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt
    ' ลบแผ่นงานชั่วคราวหลังจากนำเข้าเสร็จสิ้น (ถ้าไม่ต้องการ)
    Application.DisplayAlerts = False
    MstWbk.Sheets(MstWbk.Sheets.Count).Delete
    Application.DisplayAlerts = True
    Call addname 'นำเข้าชื่อ workbook มาใส่ในช่อง B6:B29
    Application.ScreenUpdating = True
    MsgBox "นำเข้าไฟล์สำเร็จ!", vbInformation
    Worksheets(1).Activate
End Sub

2. ผมต้องการนำเข้าชื่อ sheets ที่นำเข้ามาใหม่ไไปไว้ ที่ช่อง B6:B29 โดยไฟล์ที่นำเข้าจะมีจำนวนไม่แน่นอน บางครั้งมี 9 10 หรือ 14 แต่สูตรที่ผมเขียนจะตรงๆ รบกวนขอคำแนะนำในการปรับสูตรด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub addname()

Application.DisplayAlerts = False

   If ActiveWorkbook.Worksheets.Count >= 1 Then
      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
    End If
   
   Application.DisplayAlerts = True
   
End Sub

[snasui]

ทำข้อแรกให้ผ่านก่อนครับ

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

สิ่งที่ต้องทราบคือ การนำชือไฟล์มาใช้เป็นชื่อชีต ไฟล์นั้นจะต้องมีชื่อไม่เกิน 31 อักขระ ถ้าเกินจะ Error เป็นข้อจำกัดของ Excel ที่ยอมให้กำหนดชื่อชีตได้แค่ 31 อักขระเท่านั้นครับ

[9KiTTi]

ทำข้อแรกให้ผ่านก่อนครับ

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

สิ่งที่ต้องทราบคือ การนำชือไฟล์มาใช้เป็นชื่อชีต ไฟล์นั้นจะต้องมีชื่อไม่เกิน 31 อักขระ ถ้าเกินจะ Error เป็นข้อจำกัดของ Excel ที่ยอมให้กำหนดชื่อชีตได้แค่ 31 อักขระเท่านั้นครับ

ขอส่งไฟล์ตัวอย่างครับอาจารย์

[snasui]

ปัญหาคือบรรทัดนี้ครับ

MstWbk.Sheets(MstWbk.Sheets.Count).Delete

เป็น Code สำหรับลบชีตสุดท้ายทิ้งไป

การลบชีตใด ๆ ทิ้งไปจะต้องตรวจสอบให้มั่นใจว่าเป็นชีตที่ไม่จำเป็นใช่หรือไม่เสมอครับ

[9KiTTi]

ปัญหาคือบรรทัดนี้ครับ

MstWbk.Sheets(MstWbk.Sheets.Count).Delete

เป็น Code สำหรับลบชีตสุดท้ายทิ้งไป

การลบชีตใด ๆ ทิ้งไปจะต้องตรวจสอบให้มั่นใจว่าเป็นชีตที่ไม่จำเป็นใช่หรือไม่เสมอครับ

ขอบพระคุณครับอาจารย์ แก้ไขตามที่อาจารย์แนะนำสามารถแก้ไขได้แล้วครับ แต่ติดยังติดปัญหากรณีนำเข้าไฟล์แล้ว ให้นำชื่อ sheet มาแสดงที่ sheet ชื่อ Main ช่อง B6:B29 แต่ถ้าหากชีทที่นำเข้าไม่มีจะแสดงข้อผิดพลาด ผมปรับมาใช้โค้ดนี้แต่ก็ยังแก้ไม่ได้ รบกวนอาจารย์แนะนำด้วยครับ

Code: Select all

Sub addname2()

Application.DisplayAlerts = False

   If ActiveWorkbook.Worksheets(2).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
   End If
   
   If ActiveWorkbook.Worksheets(3).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
   End If

   If ActiveWorkbook.Worksheets(4).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
   End If
   
   If ActiveWorkbook.Worksheets(5).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
   End If
   
   If ActiveWorkbook.Worksheets(6).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
   End If
   
   If ActiveWorkbook.Worksheets(7).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
   End If
   
   If ActiveWorkbook.Worksheets(8).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
   End If
   
   If ActiveWorkbook.Worksheets(9).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
    End If
      
   If ActiveWorkbook.Worksheets(10).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
   End If
   
   
   If ActiveWorkbook.Worksheets(11).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
   End If
   
   If ActiveWorkbook.Worksheets(12).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
   End If
   
   If ActiveWorkbook.Worksheets(13).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
   End If
   
   If ActiveWorkbook.Worksheets(14).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
   End If
   
   If ActiveWorkbook.Worksheets(15).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
   End If
   
   If ActiveWorkbook.Worksheets(16).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
   End If
   
   If ActiveWorkbook.Worksheets(17).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
   End If
   
   If ActiveWorkbook.Worksheets(18).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
   End If
   
   If ActiveWorkbook.Worksheets(19).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
   End If
   
   If ActiveWorkbook.Worksheets(20).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
   End If
   
   If ActiveWorkbook.Worksheets(21).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
   End If
   
   If ActiveWorkbook.Worksheets(22).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
   End If
   
   If ActiveWorkbook.Worksheets(23).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
   End If
   
   If ActiveWorkbook.Worksheets(24).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
   End If
   
   If ActiveWorkbook.Worksheets(25).Name <> " " Then
      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
   End If
   
   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Sub

[snasui]

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

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                .Range("b30").End(xlUp).Offset(1, 0).Value = sh.Name
            End With
        End If
    Next sh
'   If ActiveWorkbook.Worksheets.Count >= 1 Then
'      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
'      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
'      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
'      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
'      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
'      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
'      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
'      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
'      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
'      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
'      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
'      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
'      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
'      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
'      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
'      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
'      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
'      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
'      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
'      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
'      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
'      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
'      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
'      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
'    End If
   
   Application.DisplayAlerts = True
   
End Sub

[9KiTTi]

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

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                .Range("b30").End(xlUp).Offset(1, 0).Value = sh.Name
            End With
        End If
    Next sh
'   If ActiveWorkbook.Worksheets.Count >= 1 Then
'      ActiveWorkbook.Worksheets(1).Range("B6") = ActiveWorkbook.Worksheets(2).Name
'      ActiveWorkbook.Worksheets(1).Range("B7") = ActiveWorkbook.Worksheets(3).Name
'      ActiveWorkbook.Worksheets(1).Range("B8") = ActiveWorkbook.Worksheets(4).Name
'      ActiveWorkbook.Worksheets(1).Range("B9") = ActiveWorkbook.Worksheets(5).Name
'      ActiveWorkbook.Worksheets(1).Range("B10") = ActiveWorkbook.Worksheets(6).Name
'      ActiveWorkbook.Worksheets(1).Range("B11") = ActiveWorkbook.Worksheets(7).Name
'      ActiveWorkbook.Worksheets(1).Range("B12") = ActiveWorkbook.Worksheets(8).Name
'      ActiveWorkbook.Worksheets(1).Range("B13") = ActiveWorkbook.Worksheets(9).Name
'      ActiveWorkbook.Worksheets(1).Range("B14") = ActiveWorkbook.Worksheets(10).Name
'      ActiveWorkbook.Worksheets(1).Range("B15") = ActiveWorkbook.Worksheets(11).Name
'      ActiveWorkbook.Worksheets(1).Range("B16") = ActiveWorkbook.Worksheets(12).Name
'      ActiveWorkbook.Worksheets(1).Range("B17") = ActiveWorkbook.Worksheets(13).Name
'      ActiveWorkbook.Worksheets(1).Range("B18") = ActiveWorkbook.Worksheets(14).Name
'      ActiveWorkbook.Worksheets(1).Range("B19") = ActiveWorkbook.Worksheets(15).Name
'      ActiveWorkbook.Worksheets(1).Range("B20") = ActiveWorkbook.Worksheets(16).Name
'      ActiveWorkbook.Worksheets(1).Range("B21") = ActiveWorkbook.Worksheets(17).Name
'      ActiveWorkbook.Worksheets(1).Range("B22") = ActiveWorkbook.Worksheets(18).Name
'      ActiveWorkbook.Worksheets(1).Range("B23") = ActiveWorkbook.Worksheets(19).Name
'      ActiveWorkbook.Worksheets(1).Range("B24") = ActiveWorkbook.Worksheets(20).Name
'      ActiveWorkbook.Worksheets(1).Range("B25") = ActiveWorkbook.Worksheets(21).Name
'      ActiveWorkbook.Worksheets(1).Range("B26") = ActiveWorkbook.Worksheets(22).Name
'      ActiveWorkbook.Worksheets(1).Range("B27") = ActiveWorkbook.Worksheets(23).Name
'      ActiveWorkbook.Worksheets(1).Range("B28") = ActiveWorkbook.Worksheets(24).Name
'      ActiveWorkbook.Worksheets(1).Range("B29") = ActiveWorkbook.Worksheets(25).Name
'    End If
   
   Application.DisplayAlerts = True
   
End Sub

สามารถทำงานได้อย่างที่ต้องการแล้วครับอาจารย์ แต่ผมยังติดปัญหาอีก 2 ข้อครับ คือ
1.หลังจากนำเข้าข้อมูล ผมต้องการรวมช่อง AQ10 (money_input) จนถึงแล้วสุดท้ายที่มี ในแต่ละชีทที่นำเข้า มาใส่ในชีท main ให้ตรงกับชื่อของแต่ละชีท ผมใช้โค้ดนี้ แต่แจ้งข้อผิดพลาด ผมต้องแก้ไขอย่างไรครับ

Code: Select all

Public Sub Sum_Money()
    
    Dim myRange As Long
    
    myRange = Worksheets("Sheet2").Range("AQ10").End(xlDown)
    
    Worksheets("Main").Range("C6") = WorksheetFunction.Sum(myRange)

End Sub

2.กรณีที่มีข้อมูลในส่วนของ outtime ในคอลลัม์ AQ ที่มีข้อมูลจำนวนเงิน จะต้องเขียนสูตรอย่างไรครับ ในส่วนนี้ผมจนปัญญาจริงๆครับ ขออภัยด้วยครับ

[snasui]

ตัวอย่างการปรับ Code ซึ่งเป็นการรวมการคำนวณเข้าไปกับ Code เดิมครับ

Code: Select all

Sub addname()

    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a1000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                End With
                
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 2).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
                End With
            End With
        End If
    Next sh

   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Su

[9KiTTi]

ขอบพระคุณครับอาจารย์ตอนนี้โปรแกรมใช้งานได้สมบูรณ์แบบอย่างที่ต้องการแล้วครับ ขอบพระคุณครับ

[9KiTTi]

พบปัญหาในการนำไฟล์เข้าครับ ถ้าหากนำเข้าทีละไฟล์จะมีไฟล์ซ้ำครับ แต่ถ้าหากนำเข้าครั้งละหลายไฟล์จะไม่เป็นอะไรครับ สามารถใช้งานได้ปกติครับ รบกวนขอคำแนะนำด้วยครับ

[snasui]

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

[9KiTTi]

ตัวไฟล์จะนำเข้า workbook ข้อมูล เข้ามาเก็บใน workbook ชื่อ test โดยเรียงลำดับตามจำนวนไฟล์ที่นำเข้า ถ้านำเข้ามาเกินกว่า 2 ไฟล์ จะไม่มีปัญหางวดรายงานที่เบิ้ล แต่ถ้าหากนำเข้าไฟล์ โค้ดนำข้อมูลเข้า

Code: Select all

Sub im_money()
    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet
    
    Dim x As Long
    Dim xx As Integer

    Application.ScreenUpdating = False
    Set MstWbk = ThisWorkbook

    'Call delsheets

    FNames = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="เลือกไฟล์ที่จะนำเข้าตรวจสอบ")
    If Not IsArray(FNames) Then Exit Sub

    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count) ' คัดลอกแผ่นงานไปท้ายสุด
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(1, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt

    ' ลบแผ่นงานชั่วคราวหลังจากนำเข้าเสร็จสิ้น (ถ้าไม่ต้องการ)
    Application.DisplayAlerts = False
    'MstWbk.Sheets(MstWbk.Sheets.Count).Delete
    Application.DisplayAlerts = True
    
For x = 1 To 100
        UpdateProgressBar x, 100
    Next x
    
    Call addname

    Application.ScreenUpdating = True
    
    MsgBox "นำเข้าไฟล์สำเร็จ!", vbInformation

    Worksheets("Main").Activate
End Sub

[9KiTTi]

ตัวโปรแกรมครับ

[snasui]

ยังไม่พบว่ามีการเขียนโปรแกรมสำหรับการจัดการปัญหาดังกล่าวในไฟล์โปรแกรมข้างต้น

หลักการคือจะต้องตรวจสอบกับชีต Main ก่อนว่ามีชีตอยู่แล้วหรือไม่ หากมีอยู่แล้วจะไม่มีการ Copy ชีตมาใช้ เช่นเดียวกัน ในขั้นตอนการ Copy ชีตมาแสดงในชีต Main ก็จะไม่ Copy มาเช่นกัน ลองพยายามมาเองก่อน ติดตรงไหนค่อยถามกันครับ

[9KiTTi]

ขอนุญาตครับ ผมขออนุญาตขอความช่วยเหลือ 2 ข้อครับ
1.หลังจากผมนำไฟล์เข้า workbook ได้แล้ว แต่หลังจากนั้นใช้คำสั่งเพื่อประมวลผลของข้อมูลจากไฟล์ชีดที่นำเข้าทั้งหมด พบว่าหากนำเข้าไฟล์ทุกไฟล์แล้วใช้ประมวลผลจะแสดงข้อมูลได้ถูกต้อง แต่หากนำไฟล์เข้าเพิ่มจะแสดงรายชื่องวดซ้ำซ้อนครับ
คำสั่งประมวลผลข้อมูล

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a10000"), 0)
                End With
                
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 10000))
                    
                    .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 10000))  
                End With
            End With
        End If
    Next sh
   Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

2.ผมลองเขียน code เพื่อทำใส่สีเฉพาะแถวที่ cell ใน คอลัมม์ AQ ที่มีค่าเท่ากับ 0 หรือน้อยกว่า 0 ทั้ง 2 ช่วงข้อมูลคือ InTime กับ OutTime แต่ด้วยความรู้ยังน้อยเกี่ยวกับ VBA จึงทำงานไม่ได้ ขอความอนุเคราะห์ชี้แนะด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub hlrow()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    
    'Application.DisplayAlerts = False
    
    For Each sh In Worksheets
        If sh.Index > 1 Then  'มากกว่า 1 ชีท
            With Sheets("Main")
                With sh
                
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                    
                    If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow
          
                End With    
            End With
        End If 
    Next sh
   'Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

[snasui]

แก้ให้ผ่านไปทีละเรื่องครับ

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

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

จำเป็นจะต้องศึกษาให้เข้าใจหากต้องการทำงานเดิมซ้ำ ๆ ที่ต้องการทำมาใช้เฉพาะค่าที่ยังไม่เคยบันทึกไว้

[9KiTTi]

แก้ให้ผ่านไปทีละเรื่องครับ

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

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

Code: Select all

'Other code
If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
    With .Range("b30").End(xlUp).Offset(1, 0)
        .Value = sh.Name
        .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
        .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
        .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
    End With
End If
'Other code

จำเป็นจะต้องศึกษาให้เข้าใจหากต้องการทำงานเดิมซ้ำ ๆ ที่ต้องการทำมาใช้เฉพาะค่าที่ยังไม่เคยบันทึกไว้

กรณี code นี้จะพบปัญหาหลังจากนำข้อมูลเพิ่ม และรันด้วย code นี้ จะมีข้อมูลในรายงานงวดซ้ำครับ เช่น ถ้านำเข้าไฟล์ชื่อ 6603_MM_01 เข้าแล้วนำเข้าไฟล์ชื่อ 6603_MM_02 เข้า แล้วรัน code นี้ จะมีไฟล์งวดชื่อ 6603_MM_01 ขึ้นมา 2 รายการครับ
ส่วน Code ที่ผมปรับแก้คือ code ที่ใช้ใส่สีในแถวที่มีข้อมูลเป็น 0 หรือน้อยกว่า 0 ในคอลัมม์ AQ ครับอาจารย์

Code: Select all

Sub hlrow()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    
    'Application.DisplayAlerts = False
    
    For Each sh In Worksheets
        If sh.Index > 1 Then  'มากกว่า 1 ชีท
            With Sheets("Main")
                With sh
                
                    itme = Application.Match("InTime", .Range("a1:a10000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                    
                    If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow
          
                End With    
            End With
        End If 
    Next sh
   'Application.DisplayAlerts = True
   Worksheets("Main").Activate
End Sub

[snasui]

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

[9KiTTi]

ต้องขออภัยอาจารย์ครับ ผมพลาดเองแก้อีกไฟล์ แต่ส่งอีกไฟล์ไปให้ครับ ตอนนี้ได้แก้ตามอาจารย์แต่เจอ error ครับ ตามภาพครับ

[snasui]

ที่ปรับมานั้น Code เดิมที่สำคัญหายไปหลายบรรทัดเลยทำงานไม่ได้

Code ที่ทำงานได้จะต้องเป็นตามด้านล่างครับ

Code: Select all

Sub addname()
    Dim sh As Worksheet
    Dim itme As Long
    Dim otme As Long
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Index > 1 Then
            With Sheets("Main")
                With sh
                    itme = Application.Match("InTime", .Range("a1:a1000"), 0)
                    otme = Application.Match("OutTime", .Range("a1:a1000"), 0)
                End With
                
            If Application.CountIfs(.Range("b6:b30"), sh.Name) = 0 Then
                With .Range("b30").End(xlUp).Offset(1, 0)
                    .Value = sh.Name
                    .Offset(0, 1).Value = Application.Sum(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 3).Value = Application.Sum(sh.Range("aq" & otme & ":aq" & 1000))
                    .Offset(0, 2).Value = Application.Count(sh.Range("aq" & itme & ":aq" & otme))
                    .Offset(0, 4).Value = Application.Count(sh.Range("aq" & otme & ":aq" & 1000))
                End With
            End If
            End With
        End If
    Next sh

   Application.DisplayAlerts = True
   
   Worksheets("Main").Activate
   
End Sub