VBA ส่งข้อมูลเข้า Workbook อื่น ใน sheet "คะแนน1" ซึ่งลงข้อมูลไม่ครบ

[aueijung]

เรียน อาจารย์ครับ ผมมีโค๊ด VBA แล้วเกิดปัญหาคือ ไฟล์ ดึงจปส.-2-2563-ม.4-1-SendMarkToPP5 - TEST.xlsm ข้อมูลในชีท จปสคะแนนสอบกลางภาค ส่งข้อมูลจากปุ่ม ส่งคะแนน Miterm2 เข้า ปพ.5 แล้วข้อมูลก็เข้า Workbook อื่น ใน Drive D:\ปพ.5\ปีการศึกษา2563\มัธยม\เทอม2\ม.4-1 ของ sheet "คะแนน1" ในแต่ละไฟล์ ซึ่งลงข้อมูลไม่ครบตามไฟล์ที่มีปัญหาคือ ไฟล์ ส31103-1.xlsm ในไฟล์นี้ ถ้าเราต้องการแก้ปัญหาโดยให้เช็คว่า ถ้า คอลัมภ์ AJ7 ได้ลงคะแนนไปแล้ว ก็ให้ข้ามมาคอลัมภ์มา AK7 โดยให้เช็ค Match ที่กำหนด แถว G3:AF3 ในชีท จปสคะแนนสอบกลางภาค ด้วย กระผมต้องปรับโค๊ดอย่างไรครับ
Module18

Code: Select all

Sub SendMarkMitterm2ToPP5_Click()
   Dim p, directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Dim bookStr As String, rw As Integer
    Application.ScreenUpdating = False
    p = Range("R1")
    directory = Sheets(p).Range("D1").Value

    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 7
    
Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    bookStr = VBA.Left(tempBook.Name, 6)
    On Error Resume Next
    With thsBook.Sheets(p)
        rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
        If Err <> 0 Then
            MsgBox "File " & tempBook.Name & " not found in Rows 5."
            Err = 0
        Else
        
            With tempBook.Sheets("คะแนน1")
                .Range("AJ7:AJ62").Value = _
                    thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, 1).Value
            End With
            
          
        End If
    End With
        'r = r + 1
        'j = j + 1
    	tempBook.Close True
      '  tempBook.Close False
        fileName = Dir()
Loop
       
    Application.ScreenUpdating = True
    MsgBox ("ส่งคะแนนเข้า ปพ.5 Directory " & Sheets(p).Range("D1").Value & " เรียบร้อยแล้วค่ะ")
 
 End Sub

[snasui]

ผมลอง Run Code ดูก็ได้คะแนนตรงกับต้นทาง กรุณาอธิบายเพิ่มเติมว่า ไม่ครบอย่างไร ขาดค่าใดไปบ้างจะได้เข้าถึงปัญหาโดยไวครับ

[aueijung]

เรียนอาจารย์ครับ มี workbook ที่มีชื่อเหมือนกันดังภาพนี้ครับ

คือข้อมูลวางตำแหน่งที่ถูกต้อง ตามวิชา สังคมศึกษา ศาสนาและวัฒนธรรม ฉ.1 คอลัมภ์ AJ7 ข้อมูลลงไฟล์ ส31103-1.xlsm แต่ วิชา สังคมศึกษา ศาสนาและวัฒนธรรม ฉ.2 คอลัมภ์ AK7 ไม่มีข้อมูลลงไฟล์เดียวกัน ส31103-1.xlsm (ไฟล์เดียวกัน ลงแต่ คอลัมภ์ AJ7 แต่ข้อมูล ไม่ลงคอลัมภ์ AK7 ของไฟล์เดียวกัน เราต้องแก้ไขโค๊ดอย่างไรครับอาจารย์)

[snasui]

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

ตัวอย่างการนำข้อมูลมาแสดงตามจำนวนที่พบคอลัมน์ก็จะเป็นด้านล่าง ซึ่งเป็นการนับว่าพบกี่คอลัมน์แล้วขยายพื้นที่ไปเท่านั้นครับ

Code: Select all

dim c as integer
'...
rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
c = application.countif(.Range("G2:AF2"),bookStr)
If Err <> 0 Then
    MsgBox "File " & tempBook.Name & " not found in Rows 5."
    Err = 0
Else

With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
End With
'...

แต่ชื่อไฟล์จะต้องอยู่ติดกัน ไม่เช่นนั้นต้องเปลี่ยนเป็นการ Loop เข้าไปหาแทนการ Match ครับ

[aueijung]

ขอบพระคุณมากครับอาจารย์ ผมเริ่มเข้าใจวิธีการทำงานจากที่อาจารย์ให้ความรู้เพิ่มขึ้นเรื่อยๆ แล้วครับ แต่มีเรื่องสงสัยอีกประการครับอาจารย์ครับ คือถ้าเรามีข้อมูลต้นทางนักเรียนบางคนมีคะแนน เป็นค่า 0 คะแนนของบางรายวิชา เราจะข้ามค่าข้อมูล 0 ไปวางคะแนนของคนต่อไป ด้วยการเช็คค่า AJ8:AJ62 ว่า ถ้ามีค่าข้อมูลเป็น 0 คะแนน ให้ข้าม ไม่วางค่า 0 คะแนนให้นักเรียนคนนั้น เพื่อที่จะให้คุณครูประจำวิชา ไปตามเช็คคะแนนกับนักเรียนคนนั้นๆ เอง (คะแนน 0 คือ นักเรียนขาดสอบ,ลาออก เราจะข้ามการวางเมื่อนักเรียนได้ 0 คะแนนอย่างไรครับผม)

[snasui]

เพื่อให้ง่าย ให้วางลงมาทั้งหมดแล้วค่อย Loop เข้าไป Clear ค่า 0 ทิ้งครับ

จาก Code ที่ผมตอบไป เราทราบอยู่แล้วว่าวางข้อมูลในช่วงไหน สามารถ Loop เข้าไปในช่วงข้อมูลนั้นเพื่อ Clear ค่าที่เป็น 0 ทิ้งไป

ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

[aueijung]

อาจารย์ครับ ผมลองปรับเป็น

Code: Select all

'...
With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
                        With Cells
                                .Replace "0", ""
                                .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
                        End With
End With
'...

ผลคือ
คนที่ได้ 0 จะได้ค่า Blank ซึ่งถูกต้องครับ ได้ค่าว่าง
แต่
คนที่ได้ 10 จะได้คะแนน 1 คะแนนแทน
คนที่ได้ 20 จะได้คะแนน 2 คะแนนแทน
คนที่ได้ 30 จะได้คะแนน 3 คะแนนแทน
คนที่ได้ 40 จะได้คะแนน 4 คะแนนแทน
คนที่ได้ 50 จะได้คะแนน 5 คะแนนแทน
คนที่ได้ 60 จะได้คะแนน 6 คะแนนแทน
ครับผม

[snasui]

แค่เปลี่ยนค่า 0 เป็นเซลล์ว่าง ไม่ใช่ให้ลบเซลล์ทิ้งครับ

ตัวอย่างการปรับ Code ให้ Clear ค่า 0 ทิ้งและ Clear เฉพาะพื้นที่ที่วางข้อมูลในครั้งนั้น ๆ ไม่ใช่ Clear ทั้งชีตครับ

Code: Select all

dim c as integer
dim r as range
'...
rw = Application.Match(bookStr, .Range("G2:AF2"), 0) - 1
c = application.countif(.Range("G2:AF2"),bookStr)
If Err <> 0 Then
    MsgBox "File " & tempBook.Name & " not found in Rows 5."
    Err = 0
Else

With tempBook.Sheets("คะแนน1")
    .Range("AJ7:AJ62").resize(,c).Value = _
        thsBook.Worksheets("จปสคะแนนสอบกลางภาค").Cells(6, j + rw).Resize(55, c).Value
    for each r in .Range("AJ7:AJ62").resize(,c)
        if r.value = 0 then r.clearcontents
    next r
End With
'...

[aueijung]

ใช่ครับอาจารย์ พอผมมาเปิดไฟล์ดูอีกที พบว่า ไฟล์ผมเละเลยครับ เลข 0 เต็มกระดาน ขอหัวเราะให้กับตรรกะอันน้อยนิดของผมครับอาจารย์ ^^
ขอบพระคุณอาจารย์มากๆ ครับผม ที่คอยชี้แนะกระผมครับ