Lookup วันที่

joo · #1

สอบถามสูตรเกี่ยวกับการ Lookup วันที่ปฏิบัติงานของแต่ละบุคคลจากซีท "ส.ค.54" ให้มาแสดงที่ซีท ตอบแทน เพื่อคำนวณจำนวนวันที่ปฏิบัติงานต้องใช้สูตรอย่างไรดีครับ

snasui · #2

ตรงชื่อสกุลกรอกไว้ให้ล่วงหน้าหรือว่าต้องการใช้สูตรเติมครับ

joo · #3

ที่ซีท ตอบแทน ตรงชื่อ-สกุล เดิมที่กรอกข้อมูลไว้ล่วงหน้าครับ เพราะระยะเวลาการปฏิบัติงานของแต่ละคนไม่เท่ากัน ถ้าคนไหนมีวันปฏิบัติงานเกิน 10 วัน ก็จะมีข้อมูล
ที่แสดงจำนวณวันปฏิบัติงาน 2 บรรทัด แต่ถ้าใช้สูตรมันก็สะดวกไม่ต้องคอยมาปรับแก้ทุกเดือนครับ

snasui · #4

ลองดูตามไฟล์แนบครับ

ผมเพิ่ม Sheet1 มาใช้สำหรับคำนวณจากนั้นค่อยนำไปวางที่ชีท ส.ค.54 ด้วย VBA โดยใช้ Code ด้านล่างครับ

Code: Select all

Sub PasteData()
Dim rAll As Range, rs As Range
Dim r As Range, rt As Range
Sheets("ตอบแทน").Range("D6:M18").ClearContents
With Sheets("ส.ค.54")
Set rAll = .Range("A5", .Range("A" & Rows.Count).End(xlUp))
End With
Set rs = Sheets("Sheet1").Range("A1")
For Each r In rAll
    If r <> "" Then
        Set rt = Sheets("ตอบแทน").Range("D18").End(xlUp).Offset(1, 0)
        rs = r.Offset(0, 1)
        With Sheets("Sheet1")
            .Range("C3").Resize(.Range("C1"), .Range("B1")).Copy
        End With
        rt.PasteSpecial Paste:=xlPasteValues, Transpose:=True
        rs.Copy
        rt.Offset(0, -3).PasteSpecial xlPasteValues
    End If
Next r
Application.CutCopyMode = False
MsgBox "Complete."
End Sub

snasui · #5

แถม Code กรณีไม่ได้ใช้สูตรช่วย แต่ให้เปลี่ยนชื่อชีท จากตอบแทนเป็น Rev, ส.ค.54 เป็น Aug ตามลำดับ (ไม่จำเป็นต้องเปลี่ยน แต่ผมเปลี่ยนเพื่อสะดวกในการคีย์และนำมาวางใน Forum)

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Sheets("Rev").Range("A6:A18,D6:M18").ClearContents
With Sheets("Aug")
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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
    End If
Next r
End Sub

joo · #6

ขอบคุณครับ...ได้ทดลองแล้วข้อมูลสามารถลิงค์มาได้ถูกต้องครับ แต่พบว่าโค๊ดแรกถ้าข้อมูลเพิ่มขึ้นเกินกว่าสองบรรทัดจะไม่สามารถแสดงข้อมูลได้ส่วนโค๊ดที่สองทำงานได้ดีกว่าครับ แต่ข้อมูลตรง C6: C18 และ N6:Q18 ไม่ยอมปรับตามข้อมูลที่เปลี่ยนแปลงครับ

snasui · #7

joo wrote: แต่ข้อมูลตรง C6: C18 และ N6:Q18 ไม่ยอมปรับตามข้อมูลที่เปลี่ยนแปลงครับ

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

joo · #8

ผมได้ลองใส่สูตรไว้ที่C6:C19 ข้อมูลก็จะเปลี่ยนตามชื่อที่ลิงค์มาได้ แต่ที่ N6:O19 ค่าที่ได้จะไม่ตรงโดยเฉพาะที่ N12 ค่าที่ได้ต้องเป็น 11 ช่วยแนะนำวิธีที่ถูกต้องด้วยครับ

snasui · #9

จาก Code ที่แนบมา ผมปรับเพิ่มให้เป็นตามด้านล่าง ลองทดสอบดูครับ

Code: Select all

Sub PasteWithDifSize()
Dim c%, i%, j%, k%
Dim rrAll As Range, rcAll As Range, rp As Range
Dim r As Range, r1 As Range
Dim strNameSheet As String
 strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
Sheets("Rev").Range("A6:A18,D6:O18").ClearContents
'With Sheets("Aug")
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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]"
    End If
Next r
End Sub

joo · #10

ขอบคุณครับท่านอาจารย์ ทดสอบแล้วสามารถทำงานได้ดีครับ
ทดสอบโค๊ดใหม่พบว่าถ้าใส่ชื่อซีทผิดจะเกิด Error ที่บรรทัดนี้ครับ
With Sheets(strNameSheet)
และถ้าต้องการให้เซลล์ L2 แสดงเป็นชื่อเดือนตามชื่อซีท ต้องปรับแก้ไขโค๊ดยังไรดีครับ ขอคำแนะนำด้วยครับ

Code: Select all

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

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
      'Worksheets(strNameSheet).Select
   Else
        MsgBox "Please try again"
    End If
Sheets("Rev").Range("A6:A18,D6:Q18").ClearContents
'With Sheets("Aug")
'On Error Resume Next
With Sheets(strNameSheet)
Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
    Range("L2") = strNameSheet
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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
End Sub

snasui · #11

ลองดูตัวอย่างการปรับ 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

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:A18,D6:Q18").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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").Range("L2")
    .Value = 1 & strNameSheet & Year(Date)
    .NumberFormat = "mmmm"
End With
End Sub

joo · #12

ทดลองแล้วใช้งานได้ตามที่ต้องการครับ
ที่ซีท Rev เรนจ์ A6:Q19 ข้อมูลจะโชว์อัตโนมัติตามการเปลี่ยนแปลงข้อมูล พบว่าแถวล่างๆ ว่างเปล่าไม่มีข้อมูล ถ้าต้องการให้ซ่อนไว้เมื่อไม่มีข้อมูลและให้แสดงเมื่อมีข้อมูลต้องปรับเพิ่มโค๊ดอย่างไรครับ

snasui · #13

ลองบันทึก Macro เพื่อดู Code การซ่อน, การยกเลิกการซ่อนบรรทัด จากนั้นนำ Code นั้นมาช่วยในการ Loop เพื่อซ่อนหรือยกเลิกการซ่อนดูครับ หากยังไม่ได้ช่วยนำ Code ที่ลองทำแล้วมาถามกันต่อครับ

joo · #14

ผมลองปรับโค๊ดเพื่อซ่อนบรรทัดที่ไม่มีข้อมูลพบว่าข้อมูลที่ลิงค์มาจากซีท Sep สามารซ่อนได้ แต่ข้อมูลที่ลิงค์มาจากซีท Aug ไม่สามารถซ่อนได้ต้องปรับแก้ไขโค๊ดแบบไหนดีครับ

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

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:A18,D6:Q18").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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 ActiveSheet
If .Range("D14,D15,D16,D17,D18,D19") = "" Then
    .Range("D14,D15,D16,D17,D18,D19").EntireRow.Hidden = True
    Else
    .Range("D14,D15,D16,D17,D18,D19").EntireRow.Hidden = False
  End If
  End With
With Sheets("Rev").Range("L2")
    .Value = 1 & strNameSheet & Year(Date)
    .NumberFormat = "mmmm"
End With
End Sub

snasui · #15

ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Option Explicit

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("D6:D18").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:A18,D6:Q18").ClearContents
With Sheets(strNameSheet)
    Set rcAll = .Range("B6", .Range("B6").End(xlDown))
End With
For Each r In rcAll
    With Sheets("Rev")
        If .Range("D6") = "" Then
            Set rp = .Range("D6").Resize(2, 10)
        Else
            Set rp = .Range("D18").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, 1).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("L2")
        .Value = 1 & strNameSheet & Year(Date)
        .NumberFormat = "mmmm"
    End With
    For Each r In .Range("D6:D18")
        If r = "" Then
            r.EntireRow.Hidden = True
        End If
    Next r
End With
End Sub

joo · #16

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

ถามเพิ่มนะครับที่เซลล์ A20 ต้องการให้แสดงการนับจำนวนในช่วง A6:A19 ว่ามีกี่รายโดยให้แสดงค่าเป็นแบบนี้คือ รวม 6 ราย
ที่ทำไว้คือ ที่เซลล์ A22คีย์ รวม
ที่เซลล์ B22คีย์ =COUNTA(A6:A19)
ที่เซลล์ C22คีย์ รวม
A20 = A22&B22&C22

snasui · #17

joo wrote:ที่เซลล์ A20 ต้องการให้แสดงการนับจำนวนในช่วง A6:A19 ว่ามีกี่รายโดยให้แสดงค่าเป็นแบบนี้คือ รวม 6 ราย

ที่ A20 คีย์สูตรนี้ครับ

="รวม "&Counta(A6:A19)&" ราย"

Enter

joo · #18

ขอบคุณครับสำหรับคำแนะนำต่างๆถ้าพบปัญหาจะกลับมาใหม่ครับ

joo · #19

มีคำถามเพิ่มครับ ที่ C5 จะแสดงวันไม่ตรงกับวันที่โดยผมปรับสูตรใหม่
ที่ C4 คีย์สูตร =DATE(YEAR(P3),MATCH($L$3,Month,0),1)
ที่เซลล์ P3 คีย์เป็นปี พ.ศ. เช่น 2555 ที่ L3 เลือกเดือน มกราคมหรือกุมภาพันธ์ ที่เซลล์ C5 จะแสดงวันได้ไม่ตรงกับวันที่ในเซลล์ C4 ส่วนเดือนอื่นๆตรงหมดครับ
แต่ถ้า ที่ C4 คีย์สูตร =DATE(YEAR(P3-543),MATCH($L$3,Month,0),1)
ค่าที่แสดงจะตรงเฉพาะเดือน ม.ค. กับ ก.พ. นอกนั้นไม่ตรงครับต้องปรับสูตรอย่างไรดีครับ

snasui · #20

ปรับสูตรที่ C4 เสียใหม่ครับ เนื่องจากว่าค่าใน P3 เป็นเลขปี พ.ศ. โดด ๆ ไม่ได้มีวัน เดือน เข้ามาเกียวข้อง สามารถนำมาใช้ได้เลยโดยไม่ต้องหาด้วยฟังก์ชัน Year แต่อย่างใด สูตรใหม่จะได้เป็น

=DATE(P3-543,MATCH($L$3,Month,0),1)

Enter

Snasui Excel Forum

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

Lookup วันที่

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 วันที่