Lookup วันที่

joo · #21

ขอบคุณครับท่านอาจารย์...ทดลองแล้วสามารถใช้งานได้ดีครับ

joo · #22

กลับมาขอคำแนะนำเพิ่มเติมครับท่่านอาจารย์...
ที่ซีท Rev คอลัมภ์ B ต้องการให้แสดงตำแหน่งให้ตรงกับชื่อในคอลัมภ์ A และที่เซลล์ E6:N6 ก็ให้แสดงข้อมูลวันที่ตามเงื่อนไขคือ " บ,ด,ชบ,ชด " เท่านั้น
ผมลองปรับโค๊ดดูแล้วพบว่าตำแหน่งมาต่อท้ายชื่อในคอลัมภ์เดียวกัน ส่วนที่จะให้แสดงข้อมูลวันที่ให้ตรงกับเงื่อนไขจะต้องปรับเพิ่มแก้ไขโค๊ดอย่างไรดีครับ

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If
Sheets("Rev").Range("A6:A40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6:C6", .Range("B6").End(xlDown)) ' โค๊ดที่ปรับแก้ไข
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
            i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
End Sub

snasui · #23

ช่วยอธิบายอีกทีครับ ตำแหน่งเอามาจากชีทไหนครับ ที่เขียนเองแล้วคือ Code ใด ติดบรรทัดใดครับ

joo · #24

ตำแหน่งเอามาจากซีท "Oct" ครับ ผมลองปรับแก้โค๊ดที่บรรทัดนี้ครับ

Code: Select all

With Sheets(strNameSheet)
    Set rcAll = .Range("B6:C6", .Range("B6").End(xlDown)) ' โค๊ดที่ปรับแก้ไข
End With

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

snasui · #25

ผมเขียนตัวอย่าง Code มาให้ตามด้านล่าง ลองปรับใช้ดูครับ

Code: Select all

Sub Test()
    Dim rAll As Range
    Dim r As Range
    Dim rSource As Range
    With Sheets("Oct")
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    End With
    With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, 2)
    End With
    For Each r In rAll
      r.Offset(0, 1) = Application.VLookup(r, rSource, 2, 0)
    Next r
End Sub

joo · #26

ขอบคุณครับท่านอาจารย์
ผมได้ทดลองโค๊ดที่อาจารย์แนะนำโดยคลิกปุ่มคำนวณให้แสดงรายชื่อออกมาก่อนจากนั้นจึงสั่งรันโค๊ดที่แนะนำ ผลคือสามารถแสดงตำแหน่งได้ตรงกับรายชื่อ ผมจึงได้ลองนำเอาโค๊ดมารวมอยู่ในปุ่มคำสั่งคำนวณแล้วสั่งรันโค๊ดผลปรากฏว่ารายชื่อตำแหน่งไม่ยอมแสดงแต่กลับแสดงค่า #N/A ที่เซลล์ B3:B5 อาจารย์ช่วยดูโค๊ดให้หน่อยครับ

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Dim rAll As Range, rt As Range, rSource As Range
 

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If
Sheets("Rev").Range("A6:A40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
    Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    'Set rcAll = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
End With
With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
           .SpecialCells(xlCellTypeConstants, 2)
     End With
For Each rt In rAll
     rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
     'rt.Offset(0, 1) = Application.VLookup(rt, rcAll, 2, 0)
     Next rt
For Each r In rcAll
      With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
        
          i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
End Sub

snasui · #27

จาก Code นี้

Code: Select all

strNameSheet = InputBox("Please enter sheet name.")

ค่าที่กรอกคือชีทใด หากกรอกชีทอื่นที่ไม่ใช่ Oct โอกาสผิดพลาดก็มีได้หากว่าตำแหน่งข้อมูลไม่ได้เริ่มที่ B6 และสิ้นสุดที่ C สุดท้ายเหมือนกัน

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

joo · #28

รับทราบครับท่านอาจารย์ ค่าที่กรอกคือซีทใดๆ ก็ได้ตามที่ user ต้องการ เช่น ทุกครั้งที่คลิกปุ่ม “คำนวณ” ก็จะต้องกรอกชื่อซีทก่อนทุกครั้ง
วิธีที่1 ผมนำโค๊ดมารวมกันโดยปรับโค๊ดใหม่สามารถแสดงผลได้ตามที่ต้องการแล้วครับ

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Dim rAll As Range, rt As Range, rSource As Range

Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next
If sCount = 0 Then
      MsgBox "Sheet name is incorrect. Please try again."
      Exit Sub
End If

Sheets("Rev").Range("A6:A40,B6:B40,E6:R40").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
    Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    'Set rcAll = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
   End With
With Sheets("Rev")
For Each r In rcAll
      With Sheets("Rev")
        If .Range("E6") = "" Then
            Set rp = .Range("E6").Resize(2, 10)
        Else
            Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
       End If
    End With
    i = 0: j = 0: c = 0
    If r.Offset(0, -1) <> "" Then
        rp.Cells(1, 0).Offset(0, -3) = r
        Set rrAll = r.Offset(0, 1).Resize(1, 31)
        For Each r1 In rrAll
        
          i = i + 1
            If r1 <> "" Then
                c = c + 1
                j = Int((c - 1) / 10) + 1
                k = (c - 1) Mod 10 + 1
                rp.Cells(j, k) = i
            End If
        Next r1
        rp.Cells(1, 1).Offset(0, 10) = c
        rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
        rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
    End If
Next r
With Sheets("Rev")
    With .Range("M2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("E6:E40")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
'Call Test
With Sheets("Rev")
      Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, 2)
    End With
    For Each rt In rAll
         rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
        Next rt
   End With
End Sub

วิธีที่2 ผมลองใช้การ Call โปรแกรมมันจะให้กรอกชื่อซีท 2 ครั้ง ไม่ทราบว่าถ้าใช้การ Call แต่ให้กรอกชื่อซีทเพียงครั้งเดียวก็ให้โปรแกรมทำงานเลย
ต้องปรับแก้ไขโค๊ดอย่างไรดีครับ
ส่วนคำถามอีกข้อหนึ่งครับอาจารย์ ในซีท Rev ในช่วงเซลล์ E6:N40 ต้องการให้แสดงวันที่ตามวันที่ปฏิบัติงานจากซีทที่เราเลือกโดยมีเงื่อนไขคือ ให้แสดงวันที่จาก
ซีทที่เราเลือกที่มีข้อความ “บ,ด,ชบ,ชด” เท่านั้น นอกเหนือจากนั้นไม่ต้องนำมาแสดง เช่น เมื่อเราเลือกซีท Oct ที่ซีท Rev ในส่วนของข้อมูลของนายกำพล
ที่เซลล์ E6:N7 จะต้องแสดงเฉพาะวันที่ 3,5,8,9,10,11,17,19,22,25,26,29 และที่เซลล์ O6 ก็จะเท่ากับ 12 วัน แนะนำด้วยครับ

snasui · #29

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

snasui · #30

เนื่องจากชีท Aug มีโครงสร้างไม่เหมือนกับชีทอื่น ๆ จึงทำให้ดึงมามาแสดงไม่ถูกต้อง สำหรับ Code ด้านล่างนี้ผมปรับมาเป็นตัวอย่างเพื่อที่จะเลือกเฉพาะ “บ,ด,ชบ,ชด” ครับ

Code: Select all

Sub PasteWithDifSize()
    Dim c%, i%, j%, k%, s%, sCount%, strNameSheet$
    Dim rrAll As Range, rcAll As Range, rp As Range
    Dim r As Range, r1 As Range
    Dim rAll As Range, rt As Range, rSource As Range
    
    Sheets("Rev").Range("E6:E40").EntireRow.Hidden = False
    strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
    For s = 1 To Worksheets.Count
        If UCase(Worksheets(s).Name) = UCase(strNameSheet) Then
           sCount = sCount + 1
        End If
    Next s
    If sCount = 0 Then
          MsgBox "Sheet name is incorrect. Please try again."
          Exit Sub
    End If
    Sheets("Rev").Range("A6:A40,B6:B40,E6:R40").ClearContents
    With Sheets(strNameSheet)
        Set rcAll = .Range("B6", .Range("B6").End(xlDown))
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
    End With
    With Sheets("Rev")
        For Each r In rcAll
'            With Sheets("Rev")
             If .Range("E6") = "" Then
                 Set rp = .Range("E6").Resize(2, 10)
             Else
                 Set rp = .Range("E40").End(xlUp).Offset(1, 0).Resize(2, 10)
            End If
'            End With
            i = 0: j = 0: c = 0
            If r.Offset(0, -1) <> "" Then
                rp.Cells(1, 0).Offset(0, -3) = r
                Set rrAll = r.Offset(0, 2).Resize(1, 31)
                For Each r1 In rrAll
                  i = i + 1
                    If r1 = "บ" Or r1 = "ด" Or r1 = "ชบ" Or r1 = "ชด" Then
                        c = c + 1
                        j = Int((c - 1) / 10) + 1
                        k = (c - 1) Mod 10 + 1
                        rp.Cells(j, k) = i
                    End If
                Next r1
                rp.Cells(1, 1).Offset(0, 10) = c
                rp.Cells(1, 1).Offset(0, 11) = "=RC[-1]*RC[-12]"
                rp.Cells(1, 1).Offset(0, 13) = "=RC[-3]*RC[-14]"
            End If
        Next r
        'With Sheets("Rev")
        With .Range("M2")
            .Value = 1 & strNameSheet & Year(Date)
            .NumberFormat = "mmmm"
        End With
        For Each r In .Range("E6:E40")
            If r = "" Then
                r.EntireRow.Hidden = True
            End If
        Next r
        'End With
        'With Sheets("Rev")
        Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
              .SpecialCells(xlCellTypeConstants, 2)
        'End With
        For Each rt In rAll
             rt.Offset(0, 1) = Application.VLookup(rt, rSource, 2, 0)
        Next rt
    End With
End Sub

joo · #31

ขอบคุณครับท่านอาจารย์
จากไฟลล์เดิมผมพบปัญหาอีกข้อหนึ่งครับกรณีที่ค่าในคอลัมภ์ A กับ คอลัมภ์ B มีค่าไม่ตรงกัน เช่น ที่เซลล์ B42 ก็จะเกิดค่า #N/A ครับ ผมได้แนบไฟล์เดิมมาให้อาจารย์ช่วยทดสอบ สำหรับโค๊ดล่าสุดที่แนะนำมาเดี๋ยวขอทดลองดูก่อนครับ

snasui · #32

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

joo · #33

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

Code: Select all

If r1 = "^(O)" Or r1 = "?" Or r1 = "^(a)^(O)" Or r1 = "^(a)?" Then

ปรับเป็น

Code: Select all

If r1 = "ชบ" Or r1 = "ชด" Or r1 = "บ" Or r1 = "ด" Then

สามารถแสดงผลได้ถูกต้องครับ
แต่ค่าที่ B42 แสดงผล #N/A ยังแก้ไขไม่ได้ครับ
และจากโค๊ดนี้

Code: Select all

If r1 = "^(O)" Or r1 = "?" Or r1 = "^(a)^(O)" Or r1 = "^(a)?" Then

ช่วยอธิบายความหมายของตัวแปรที่อยู่ในเครื่องหมาย " " หน่อยครับว่ามันแทนค่าอะไร ทำไมผมปรับให้เป็นภาษาไทยจึงสามารถแสดงผลได้ถูกต้องครับ

snasui · #34

ผมเขียนเป็นภาษาไทยครับ แต่ตอนโพสต์ไม่ได้เปลี่ยนภาษาในคอมพ์ให้เป็นภาษาไทยก่อน ก็เลยแสดงอักขระแปลก ๆ ตอนนี้กลับไปแก้ให้แล้วครับ

แนบไฟล์ที่แสดงผลเป็น #N/A มาดูกันครับ

snasui · #35

กรณีติด #N/A ที่เซลล์ B42 ให้ปรับ Code ใหม่ จากเดิม

Code: Select all

Set rAll = .Range("A6", .Range("A" & Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeConstants, 2)

เป็นด้านล่างครับ

Code: Select all

Set rAll = .Range("A6", .Range("A41").End(xlUp)) _
    .SpecialCells(xlCellTypeConstants, 2)

joo · #36

ทดลองแล้วครับยังคงติดค่า #N/A เหมือนเดิม ตามไฟล์แนบครับ

snasui · #37

ก่อนการทดสอบได้ลบค่าในเซลล์ B42 ทิ้งไปแล้วยังครับ

joo · #38

ขอบคุณครับผม... สงสัยวันนี้ผมคงจะเบลอไปหน่อย สับสนจนมองข้ามไป ลองลบตามที่แนะนำแล้วโค๊ดก็สามารถทำงานได้ดีทั้งของเดิมและของใหม่ที่อาจารย์ได้แนะนำไว้ครับ
ขอถามเพิ่มนะครับ ผมได้นำข้อมูลของตารางเวรปกติกับของตารางเวร OT มารวมอยู่ในตารางเดียวกันโดยทำปุ่มเพิ่มให้คลิกเลือกการคำนวณไว้ โดยมีเงื่อนไขคือ
1.เมื่อคลิกปุ่ม "คำนวณปกติ" แล้วเลือกชื่อซีท ก็ให้แสดงวันที่เฉพาะแถวปกติในช่วงเซลล์ที่มีข้อมูล " บ,ด,ชบ,ชด " นอกเหนือจากนี้ไม่ต้องนำมาแสดง
2.เมื่อคลิกปุ่ม "คำนวณOT" แล้วเลือกชื่อซีท ก็ให้แสดงวันที่เฉพาะแถวOTในช่วงเซลล์ที่มีข้อมูล " ช,บ,ด,ชบ,ชด,BD,BDบ,BDด " นอกเหนือจากนี้ไม่ต้องนำมาแสดง

ตัวอย่าง เช่น เมื่อคลิกปุ่ม "คำนวณปกติ" เลือกซีท Nov ข้อมูลเวรปกติของนายกำพล ก็จะแสดงเฉพาะวันที่3,8,9,10,17,22,29 รวมทั้งหมดที่เซลล์ O6
ก็จะเท่ากับ 7 วัน
เมื่อคลิกปุ่ม "คำนวณOT" เลือกซีท Nov ข้อมูลเวรOTของนายกำพล ก็จะแสดงเฉพาะวันที่ 7,13,21,27,28 รวมทั้งหมดที่เซลล์ O6 ก็จะเท่ากับ 5 วัน
ตรงนี้ต้องกำหนดเงื่อนไขในโค๊ดเพิ่มเติมอย่างไรดีครับ ขอคำแนะนำด้วยครับ

snasui · #39

Code ที่ลองปรับมาเองแล้วอยู่ที่ Procedure ใดครับ

joo · #40

ชี้แนะแนวทางด้วยครับ ผมลองกำหนดตัวแปรเพิ่มเพื่อจะแยกข้อมูลที่คอลัมภ์ D เพื่อที่จะกำหนด Source ให้มันแยกข้อมูลในคอลัมภ์ D ได้อย่างไรระหว่าง “ปกติ “และ “OT” หรือว่าต้องแยก “ปกติ “และ “OT” ให้อยู่คนละคอลัมภ์ดีครับ หรือว่าทำผิดแนวทางครับ

Code: Select all

With Sheets(strNameSheet)
        Set rcAll = .Range("B6", .Range("B6").End(xlDown))
        Set rSource = .Range("B6", .Range("C" & Rows.Count).End(xlUp))
        Set rNo = .Range("B6", .Range("D" & Rows.Count).End(xlUp))
        Set rOt = .Range("B6", .Range("E" & Rows.Count).End(xlUp))
    End With

Snasui Excel Forum

File Anatomy Add-in: แก้ปัญหาไฟล์ Excel ช้า แฮงก์ และไม่เสถียร อย่างมืออาชีพ

Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่

Re: Lookup วันที่