กรอกข้อมูลเว้นแถวปรับ Code อย่างไรให้ได้ข้อมูลมาครบคะ

[suka]

เรียนอาจารย์และท่านผู้รู้ค่ะ

ที่ไฟล์ FrRM_ex ชีท FormRM_ex เซลล์ C8:I11 ใช้สูตรดึงวัตถุดิบมาเป็นชุดตามรหัสจากเซลล์ J5 จากตัวอย่างไฟล์แนบที่เซลล์ K8:L12 กรอกตัวเลขครบทุกแถว Code ไม่มีปัญหาใดใช้ได้ค่ะ

หากมีการกรอกตัวเลขไม่ครบ ตัวอย่างเช่นเซลล์ K8:L12 แถวที่ 1 กรอกจำนวน แถวที่ 2 ว่าง แถวที่ 3 กรอกจำนวน แถวที่ 4 กรอกจำนวน ติดปัญหาค่ะ Code นำข้อมูลแถวที่ 1-3 มาแถวที่ 4 ไม่มาค่ะ

ความต้องการให้นำข้อมูลมาเฉพาะแถวที่ใส่จำนวนตัวเลขมาเท่านั้นค่ะ แถวไหนไม่มีตัวเลขไม่ต้องนำมาค่ะ โค๊ดด้านล่างนี้ต้องการอย่างไรคะ

ตัวอย่างที่ต้องการตามไฟล์ Material_BSh ที่ระบายสีเหลืองค่ะ Code ติดที่ระบายสีแดงค่ะ
ขอบคุณค่ะ

Code: Select all

Sub MainCode_ex()
    Dim formBook As Workbook
    Dim i As Integer
    Dim e As Long
    Dim rs As Range
    Dim rt As Range
    Dim rk As Range
    Set formBook = ThisWorkbook
   Set wbShare = Workbooks("Material_BSh.xlsx")
    With wbShare
           e = .Sheets("Stock_MR").Range("B" & Rows.Count).End(xlUp).Value + 1    'หาเลขสุดท้ายแลัว + 1
          formBook.Worksheets("FormRM_ex").Range("E5").Value = e
    End With
    wbShare.Save
    i = Worksheets("FormRM_ex").Range("B6").Value
    With formBook.Worksheets("Template")
            Set rs = .Range(.Range("a2"), .Range("p" & i + 1))
    End With
    
    Set rt = wbShare.Sheets("Stock_MR").Range("A1048576").End(xlUp).Offset(1, 0)
   If Worksheets("FormRM_ex").Range("l5") = True Then
        MsgBox "Please check your data. This transaction already recorded."
        Exit Sub
    End If
    If Worksheets("FormRM_ex").Range("l5") = "" Then
        MsgBox "Your data is empty. Fill your data and click record button again."
        Exit Sub
    End If
    rs.Copy: rt.PasteSpecial xlPasteValues
    Sheets("FormRM_ex").Range("k8:l12,n8:n12").ClearContents
       With formBook.Sheets("FormRM_ex")
            .Range("E5") = .Range("E5") + 1
        End With
    Application.CutCopyMode = False
End Sub

[snasui]

ในชีต FormRM_ex ปรับสูตรที่เซลล์ B6 เป็นด้านล่างครับ

=MATCH(9.99999999999999E+307,B8:B12)

Enter จากนั้นปรับ Code ดังนี้

1. เพิ่มการประกาศตัวแปร dim r as range ต่อจากเดิมที่มีอยู่แล้ว
2. ปรับ Code เดิมที่ใช้สำหรับ Copy และวางข้อมูล (บรรทัดก่อน Code ที่ใช้ Clear Contents) เป็นด้านล่าง โดยย้ายบรรทัดที่ทำการกำหนดค่าให้กับตัแปร rt มาไว้ที่ Code นี้ด้วย

   Code: Select all

   For Each r In rs.Columns(4).Cells
       If r.Value <> "" Then
           Set rt = wbShare.Sheets("Stock_MR").Range("A1048576").End(xlUp).Offset(1, 0)
           rs.Rows(r.Rows).Copy: rt.PasteSpecial xlPasteValues
       End If
   Next r
   

[suka]

ขอบคุณค่ะอาจารย์ โค๊ดได้ตรงตามที่ต้องการแล้วค่ะ

ขอรบกวนถามความหมายของโค๊ด For Each r In rs.Columns(4).Cells นี้ จากตัวอย่างไฟล์หมายถึงไฟล์ Material_BSh คอลัมน์ D ใช่ไหมคะ

[bank9597]

ขอบคุณค่ะอาจารย์ โค๊ดได้ตรงตามที่ต้องการแล้วค่ะ

ขอรบกวนถามความหมายของโค๊ด For Each r In rs.Columns(4).Cells นี้ จากตัวอย่างไฟล์หมายถึงไฟล์ Material_BSh คอลัมน์ D ใช่ไหมคะ

ตามนั้นครับ

[suka]

ขอบคุณค่ะคุณ bank9597

ขอบคุณอาจารย์มากค่ะ โค้ดช่วยให้ทำง่ายและประหยัดเวลาได้มากๆค่ะ

[snasui]

ขอบคุณค่ะอาจารย์ โค๊ดได้ตรงตามที่ต้องการแล้วค่ะ

ขอรบกวนถามความหมายของโค๊ด For Each r In rs.Columns(4).Cells นี้ จากตัวอย่างไฟล์หมายถึงไฟล์ Material_BSh คอลัมน์ D ใช่ไหมคะ

มาขยายความให้อีกนิดครับ

rs.Columns(4).Cells คือคอลัมน์ที่ 4 ของตัวแปร rs ซึ่งเป็นช่วงข้อมูลต้นทาง แต่เนื่องจากว่ามีการ Copy ตัวแปร rs แล้วไปวางในคอลัมน์ A ของไฟล์ปลายทาง ตำแหน่งคอลัมน์ที่ 4 ของตัวแปร rs จึงไปตรงกับคอลัมน์ D ของไฟล์ปลายทาง

Code นี้เป็นการตรวจสอบค่าในคอลัมน์ที่ 4 ของตัวแปร rs ทีละเซลล์ว่าว่างหรือไม่ว่าง หากไม่ว่างให้ Copy ค่าของตัวแปร rs ทั้งบรรทัดไปวางยังปลายทางครับ

[suka]

อ่อค่ะ ตัวแปร rs ช่วงข้อมูลต้นทางไฟล์นี้เท่ากับค่าในชีท Template คอลัมน์ D

ขอบพระคุณค่ะอาจารย์

[suka]

เรียนอาจารย์ค่ะ ขอรบกวนช่วยเรื่องปรับโค้ดค่ะ
ที่ชีท Template ข้อมูลเริ่มที่เซลล์ A12:L17 ใช้โค้ดด้านล่างนี้ค่ะ

Code: Select all

With formBook.Worksheets("Template")
    Set rs = .Range(.Range("A12"), .Range("L12" & i + 1))
End With

สามารถวางข้อมูลได้ตามต้องการ แต่มีฟ้องระบายสีเหลืองที่โค้ดค่ะ ตรงสีแดงค่ะ
rs.Rows(r.Rows).Copy: rt.PasteSpecial xlPasteValues

ด้านล่างนี้เป็นโค้ดทั้งชุดที่ใช้ร่วมกันค่ัะ

Code: Select all

Sub Main_ex()
    Dim formBook As Workbook
    Dim i As Integer
    Dim e As Long
    Dim rs As Range
    Dim rt As Range
    Dim rk As Range
    Dim r As Range
    Set formBook = ThisWorkbook
   Set wbShare = Workbooks("Material_BSh.xlsx")
    With wbShare
           e = .Sheets("Stock_MR").Range("B" & Rows.Count).End(xlUp).Value + 1
          formBook.Worksheets("FormRM_ex").Range("E5").Value = e
    End With
    wbShare.Save
    i = Worksheets("FormRM_ex").Range("B6").Value
    With formBook.Worksheets("Template")
            Set rs = .Range(.Range("A12"), .Range("L12" & i + 1))
    End With

    For Each r In rs.Columns(4).Cells
        If r.Value <> "" Then
            Set rt = wbShare.Sheets("Stock_MR").Range("A1048576").End(xlUp).Offset(1, 0)
            rs.Rows(r.Rows).Copy: rt.PasteSpecial xlPasteValues
        End If
    Next r

    If Worksheets("FormRM_ex").Range("L5") = "" Then
        MsgBox "Your data is empty. Fill your data and click record button again."
        Exit Sub
    End If
   
    Sheets("FormRM_ex").Range("k8:l12,n8:n12").ClearContents
       With formBook.Sheets("FormRM_ex")
            .Range("E5") = .Range("E5") + 1
        End With
    Application.CutCopyMode = False
End Sub

[snasui]

ลองปรับเป็น rs.Rows(r.Row) ครับ

[suka]

ขอบคุณค่ะอาจารย์ Code ใช้ได้แล้วค่ะ

[suka]

เรียนอาจารย์ค่ะ
ขอรบกวนช่วยดูไฟล์ตัวอย่างโค้ดชื่อ PasteFG และ PasteEmp ทั้ง 2 Code
เขียนเหมือนกัน PasteFG สามารถวางข้อมูลได้โดยไม่มีฟ้องใดๆ

ต่างกับโค้ดชื่อ PasteEmp ที่สามารถวางข้อมูลได้แต่มีฟ้องตามรูปแนบค่ะ
ไม่ทราบควรปรับอย่างไรค่ะ

[snasui]

ทบทวนที่ผมตอบไว้ได้านบนแล้วปรับให้ตรงตามนั้นทุกอักขระครับ

[suka]

Code: Select all

i = Worksheets("Form").Range("I2").Value

อาจารย์คะ i ที่ชีท Form หากข้อมูลเรียงตามแนวคอลัมน์ โค้ดด้านล่างเขียนเหมือนเรียงตามแถวไหมคะ ตัวอย่างรูปปแนบค่ะ

Code: Select all

 i = Worksheets("Form").Range("I2").Value
    With formBook.Worksheets("Template")
            Set rs = .Range("A12:L12").Resize(i + 1)
    End With
    For Each r In rs.Columns(4).Cells
        If r.Value <> "" Then
            Set rt = wbShare.Sheets("Employees").Range("A1048576").End(xlUp).Offset(1, 0)
              rs.Rows(r.Row).Copy: rt.PasteSpecial xlPasteValues
        End If
    Next r

[snasui]

ไม่กระจ่างในสิ่งที่ถามมาครับ

Code นั้นเป็นการ Loop คอลัมน์ที่ 4 ของตัวแปร rs หากพบว่าเซลล์ใดในคอลัมน์นั้นไม่เป็นค่าว่าง ให้ Copy ทั้งบรรทัดไปยังตำแหน่งปลายทาง

ประเด็นที่สงสัยคืออะไรครับ

[suka]

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

Code: Select all

  i = Worksheets("Form").Range("I2").Value
  With formBook.Worksheets("Template")
      Set rs = .Range("A12:L12").Resize(i + 1)
  End With

ลองเติม s ที่โค้ดด้านล่างที่ระบายสีแดงค่ะ rs.Rows(r.Rows).Copy
ทำให้วางข้อมูลได้ตรงตามต้องการแล้วค่ะ ตัวอย่างรูปแนบที่ระบายสีเหลืองค่ะ ขอบคุณอาจารย์มากค่ะ

Code: Select all

For Each r In rs.Columns(4).Cells
        If r.Value <> "" Then
            Set rt = wbShare.Sheets("Emp").Range("A1048576").End(xlUp).Offset(1, 0)
              rs.Rows(r.Rows).Copy: rt.PasteSpecial xlPasteValues
        End If
    Next r

[snasui]

rs.rows(r.rows).copy ในเครื่องผมไม่สามารถใช้ได้ครับ

แต่ rs.rows(r.row).copy สามารถใช้ได้ เป็นการ Copy ตัวแปร rs ในบรรทัดที่เป็นค่าบรรทัดของตัวแปร r โดย Copy ไปทั้งบรรทัด

r.rows คือค่าของตัวแปร r เมื่อ r เป็นเซลล์เดี่ยวๆ แต่หาก r เป็นช่วงเซลล์ จะเกิด Error ครับ
r.row คือค่าบรรทัดของตัวแปร r

แต่เมื่อคุณ suka สามารถใช้ rs.rows(r.rows).copy ได้ก็ยินดีด้วยครับ

[suka]

อาจารย์คะ ใช้โค้ดนี้

Code: Select all

rs.Rows(r.Row).Copy: rt.PasteSpecial xlPasteValues

กับโค้ดทั้งชุดด้านล่าง ข้อมูลที่บันทึกไปไฟล์ Material_BookShare.xlsx ชีท Emp ไม่ได้ตามต้องการ ตัวอย่างไฟล์แนบชีท Emp ระบายสีแดง ที่ต้องการระบายสีเหลืองค่ะ ไม่ทราบว่าโค้ดด้านล่างเขียนไม่ผิดที่จุดใดค่ะ

Code: Select all

Sub InEmp()
Application.ScreenUpdating = False
    Dim formBook As Workbook
    Dim i As Integer
    Dim e As Long
    Dim rs As Range
    Dim rt As Range
    Dim rk As Range
    Dim r As Range
    Set formBook = ThisWorkbook
   Set wbShare = Workbooks("Material_BookShare.xlsx")
    With wbShare
           e = .Sheets("Emp").Range("B" & Rows.Count).End(xlUp).Value + 1
          formBook.Worksheets("Form").Range("J5").Value = e
    End With
    wbShare.Save
    i = Worksheets("Form").Range("I2").Value
    With formBook.Worksheets("Template")
            Set rs = .Range("A12:L12").Resize(i + 1)
    End With

    For Each r In rs.Columns(4).Cells
        If r.Value <> "" Then
            Set rt = wbShare.Sheets("Emp").Range("A1048576").End(xlUp).Offset(1, 0)
              rs.Rows(r.Row).Copy: rt.PasteSpecial xlPasteValues
        End If
    Next r

        With formBook.Sheets("Form")
            .Range("J5") = .Range("J5") + 1
        End With
    Application.CutCopyMode = False
End Sub

[snasui]

จากตัวอย่างไฟล์ที่แนบมา สามารถใช้ rs.rows(r.rows) เพื่อ Return ค่าบรรทัดที่ตัวแปร r หรือจะใช้เป็น rs.rows(r) ก็ได้เช่นกัน

ผมปรับ Code บางส่วนมาเป็นตัวอย่างเพื่อให้กระชับลงตามด้านล่างครับ

Code: Select all

With wbShare.Sheets("Emp")
       e = .Range("B" & .Rows.Count).End(xlUp).Row + 1
      formBook.Worksheets("Form").Range("J5").Value = e
End With

wbShare.Save

i = formBook.Worksheets("Form").Range("I2").Value

With formBook.Worksheets("Template")
        Set rs = .Range("A12:L12").Resize(i + 1)
End With

For Each r In rs.Columns(4).Cells
    If r.Value <> "" Then
        Set rt = wbShare.Sheets("Emp").Range("A1048576").End(xlUp).Offset(1, 0)
        rs.Rows(r).Copy: rt.PasteSpecial xlPasteValues
    End If
Next r

[suka]

อาจารย์ช่วยปรับโค้ด ได้รับความรู้ความเข้าใจมากขึ้นมากเลยค่ะ ขอบพระคุณค่ะอาจารย์