:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser
🪷 คำแสดงเจตนา
ขอผลแห่งการให้ความรู้นี้ จงกลับไปยังผู้ที่เป็นเจ้าของเดิม แม้ข้าพเจ้าจะไม่รู้จักท่านก็ตาม ขอให้แสงแห่งปัญญาที่ท่านเคยจุดไว้ ได้กลับไปเติมเต็มชีวิตของท่านอีกครั้ง และขอให้เจตนาของข้าพเจ้าเป็นการคืนความดีอย่างสงบ

ช่วยปรับสูตรให้หน่อยครับ

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

ช่วยปรับสูตรให้หน่อยครับ

#1

Post by yangkodza »

Code: Select all

' Range("A4:E4").Resize(20, 5).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"       อันนี้ทำงานได้ปกติ
Range("A4:E4").Resize(20, 5).Formula = "='" & CurrDir & "\" & fileName & "'!สรุป1A1:E113"  ' ปรับล้อมา จะเอาเป็น ชีท สรุป1 A1:E113  ยังงัยครั
จากสูตรบรรทัดบนใช้งานได้ตามปกติ
ผมอยากปรับล้อมาเป็นบรรทัดล่างครับ โดยให้อ้างอิงตามที่เราระบุแทนไม่ต้องผ่านตัวแปร
ในที่นี้ให้อ้างอิงไปที ชีตสรุป1 เซลล์ A1:E113 ครับ
รบกวนช่วยชี้แนะด้วยครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#2

Post by snasui »

:D ลองปรับจาก "'!สรุป1A1:E113" เป็น "สรุป1'!A1:E113" ดูครับ
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#3

Post by yangkodza »

snasui wrote: Thu Jun 09, 2022 8:51 am :D ลองปรับจาก "'!สรุป1A1:E113" เป็น "สรุป1'!A1:E113" ดูครับ
ตอนนี้ผมปรับเป็นแบบนี้ครับ

Code: Select all

Sub ดึงไฟล์ฐานข้อมูล()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:E113").Copy
        ThisWorkbook.Worksheets("ฐานข้อมูลรายวัน").Range("A1").PasteSpecial xlPasteValues
        OpenBook.Close False
        Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A112")
    Range("A2:A112").Select
    Range("A2").Select
        Sheets("ใบลงเวลาทำงาน").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("I7:I117").Select
    Selection.ClearContents
    Range("A1:J1").Select
        Range("A1").Select
    End If
    Application.ScreenUpdating = True
End Sub
แต่พบปัญหา ดังนี้
1. ตัวไฟล์ต้นฉบับ เป็น 97-2003 ถ้าเปิดต้นฉบับโดยตรง Code จะ error ดังภาพ
Capture01.PNG
2. ต้องแปลงไฟล์ให้เป็น XLSX (มีวิธีเปิดตรงๆโดยไม่ต้องแปลงไหมครับ)
แต่ก็ยังเจอ ข้อความนี้อยู่ ดังภาพ
Capture.PNG
ตัวไฟล์งานหลักคือ ไฟล์ใบลงเวลาทำงาน
ที่แผ่นงาน ฐานข้อมูลรายวัน จะมีปุ่ม มาโคร ไว้ดึงงานครับ
สอบถามอาจารย์.rar
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#4

Post by snasui »

:D ไฟล์นามสกุล .xls เป็นไฟล์เสียหาย ไม่สามารถเข้าถึงเนื้อไฟล์ได้ครับ

สำหรับการปรับ Code ไม่ให้ฟ้องของ Clipboard สามารถเปลี่ยนการ Copy ไปเป็นด้านล่างครับ

Code: Select all

'Other code
'        OpenBook.Sheets(1).Range("A1:E113").Copy
'        ThisWorkbook.Worksheets("ฐานข้อมูลรายวัน").Range("A1").PasteSpecial xlPasteValues
        ThisWorkbook.Worksheets("ฐานข้อมูลรายวัน").Range("a1:e113").Value = OpenBook.Sheets(1).Range("a1:e113").Value
'Other code
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#5

Post by yangkodza »

snasui wrote: Sat Jun 11, 2022 6:09 am :D ไฟล์นามสกุล .xls เป็นไฟล์เสียหาย ไม่สามารถเข้าถึงเนื้อไฟล์ได้ครับ

สำหรับการปรับ Code ไม่ให้ฟ้องของ Clipboard สามารถเปลี่ยนการ Copy ไปเป็นด้านล่างครับ

Code: Select all

'Other code
'        OpenBook.Sheets(1).Range("A1:E113").Copy
'        ThisWorkbook.Worksheets("ฐานข้อมูลรายวัน").Range("A1").PasteSpecial xlPasteValues
        ThisWorkbook.Worksheets("ฐานข้อมูลรายวัน").Range("a1:e113").Value = OpenBook.Sheets(1).Range("a1:e113").Value
'Other code
สำหรับไฟล์ .xls ok ครับผมคงต้องแปลงต่อไป
แต่ตัว Code ไม่ให้ฟ้องของ Clipboard ข้อมูลไปครับ แต่ติดปัญหาแปลกๆ ตรงวันที่ ทุกไฟล์ตีกลับเป็น 6/7/2022 แต่ข้อมูลส่วนอื่นๆไปครบครับ เปิดเทียบไฟล์ต้นฉบับ(วันที่ต้นฉบับก็ถูกครับ)
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#6

Post by snasui »

:D วันที่ดังกล่าวอยู่ ณ ตำแหน่งใด อยู่ในของเขตของ A1:E113 หรือไม่ หากไม่อยู่ก็จะไม่ถูกนำค่าไปใช้ แต่หากอยู่ในขอบเขตของพื้นที่ข้างต้นค่านั้นจะถูกนำไปใช้ด้วยค่าเดียวกัน เพราะ Code ที่ใช้นั้นเป็นการกำหนดค่าปลายทางให้เท่ากับค่าต้นทางแบบตรง ๆ ครับ
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#7

Post by yangkodza »

อาจารย์ครับ ผมปรับหนีจาก .xls ใช้ดึง .csv แทน ดัง code แนบ

Code: Select all

Sub ดึงฐานข้อมูล()
Dim wsheet As Worksheet, file_mrf As String
Application.ScreenUpdating = False
    Sheets("ฐานข้อมูลรายวัน").Select
Set wsheet = ActiveWorkbook.Sheets("ฐานข้อมูลรายวัน")
    Columns("A:F").Select
    Range("F1").Activate
    Selection.ClearContents
    Range("A1").Select
file_mrf = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Provide Text or CSV File:")
With wsheet.QueryTables.Add(Connection:="TEXT;" & file_mrf, Destination:=wsheet.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
    Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A112")
    Range("A2:A112").Select
    Columns("A:A").Select
    Selection.NumberFormat = "General"
    Columns("E:E").Select
    Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Columns("F:F").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("ใบลงเวลาทำงาน").Select
    Range("I7:I117").Select
    Selection.ClearContents
    Range("A7").Select
    Application.ScreenUpdating = True
End With
End Sub
มีบัคตรง 0:00 ครับ ดังภาพประกอบ
Capture01.PNG
เซลล์ดังกล่าวใช้ code

Code: Select all

=IFERROR(IF(LEN(E4)=5,"",RIGHT(E4,5)+0),"")
ส่งผลให้เซลด้านหลังไม่แสดงเป็นคำว่า ไม่รูดเข้า/ออก เนื่องจากโชว์ค่า 2 ค่า
รบกวนอาจารย์ชี้แนะให้แสดงเพียงค่าเดียว กรณีรูดครั้งเดียวด้วยครับ
สอบถามอาจารย์.rar
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#8

Post by snasui »

:D ที่ชีต ฐานข้อมูลรายวัน เซลล์ H2 ปรับสูตรเป็นด้านล่างครับ

=IFERROR(IF(LEN(TEXT(E2,"hh:mm"))=5,"",RIGHT(E2,5)+0),"")

Enter > Copy ลงด้านล่าง
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#9

Post by yangkodza »

snasui wrote: Sat Jun 11, 2022 7:46 pm :D ที่ชีต ฐานข้อมูลรายวัน เซลล์ H2 ปรับสูตรเป็นด้านล่างครับ

=IFERROR(IF(LEN(TEXT(E2,"hh:mm"))=5,"",RIGHT(E2,5)+0),"")

Enter > Copy ลงด้านล่าง
สามารถใช้งานตามที่ต้องการได้แล้วครับ
ขอบคุณมากครับอาจารย์ :D
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#10

Post by yangkodza »

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

Code: Select all

Sub เก็บฐานข้อมูล()
Application.ScreenUpdating = False
    Sheets("ใบลงเวลาทำงาน").Select
    Range("I7:I117").Select
    Selection.Copy
    Sheets("สถิติ").Select
        Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("ฐานข้อมูลรายวัน").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("สถิติ").Select
    Range("C1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-th-TH,107]d mmm yy;@"
    Columns("C:C").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Replace What:="ไม่รูดเข้า/ออก", Replacement:="ม", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ขาด", Replacement:="ข", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลากิจ", Replacement:="ก", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาป่วย", Replacement:="ป", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาคลอด", Replacement:="ค", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ไปราชการ", Replacement:="ร", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="สาย", Replacement:="ส", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
        Sheets("ใบลงเวลาทำงาน").Select
    Application.ScreenUpdating = True
End Sub
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#11

Post by snasui »

:D แนบไฟล์ตัวอย่างที่มี Code นี้มาด้วยจะได้สะดวกในการตอบของเพื่อนสมาชิกครับ
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#12

Post by yangkodza »

snasui wrote: Sun Jun 12, 2022 7:07 pm :D แนบไฟล์ตัวอย่างที่มี Code นี้มาด้วยจะได้สะดวกในการตอบของเพื่อนสมาชิกครับ
ครับผม
สอบถามอาจารย์.rar
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#13

Post by snasui »

:D ช่วยอธิบายว่าต้องการจะทำอะไร มีลำดับขั้นตอนการทำงานอย่างไร ติดขัดตรงส่วนไหน อย่างไร จะได้เข้าถึงปัญหาโดยไวครับ
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#14

Post by yangkodza »

snasui wrote: Sun Jun 12, 2022 8:58 pm :D ช่วยอธิบายว่าต้องการจะทำอะไร มีลำดับขั้นตอนการทำงานอย่างไร ติดขัดตรงส่วนไหน อย่างไร จะได้เข้าถึงปัญหาโดยไวครับ
จากงานดังกล่าว
1. ดึงข้อมูลจาก CSV (ผ่าน)
2. ทำการเช็คขาด ว่าขาดจากสาเหตุใด เช่น ลาป่วย ลากิจ (ตรงนี้ต้องทำมือ เพราะรอธุรการแจ้ง) (ผ่าน)
3. กลับสถานะปกติ คือปลดตัวกรองออกไป (ผ่าน)
4. ต้องการ เก็บฐานข้อมูล ลง สถิติ (ยังไม่ผ่าน)
5 พิมพ์รายงาน (ผ่าน)

จากข้อ 4. จะทำการ copy ข้อมูลจาก แผ่นงานใบลงเวลาทำงาน I7:I117 ไปไว้ที่ แผ่นงานสถิติ แถวที่ 2 โดยไปคอลัมน์ทางขวาใหม่ตลอดทุกครั้ง และ ที่ แผ่นงานสถิติ C1 ต้องมีวันที่ด้วย วันที่ อ้างอิงมาจาก แผ่นงานฐานข้อมูลรายวัน D2 ครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#15

Post by snasui »

:D เท่าที่สังเกตไม่ได้ทำแค่คัดลอกข้อมูลไปวาง แต่มีการเปลี่ยนค่าด้วย กรุณาอธิบายขั้นตอนการทำงานของข้อ 4 มาอย่างละเอียดพร้อมทั้งแจ้งขั้นตอนที่ยังติดปัญหามาด้วยครับ
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#16

Post by yangkodza »

snasui wrote: Sun Jun 12, 2022 9:22 pm :D เท่าที่สังเกตไม่ได้ทำแค่คัดลอกข้อมูลไปวาง แต่มีการเปลี่ยนค่าด้วย กรุณาอธิบายขั้นตอนการทำงานของข้อ 4 มาอย่างละเอียดพร้อมทั้งแจ้งขั้นตอนที่ยังติดปัญหามาด้วยครับ
จากข้อ 4
ลักษณะการทำงานตอนนี้คือ รันมาโครตรงๆยังไม่ได้สร้างปุ่มครับ มาโครเก็บฐานข้อมูล
การทำงานคือ copy วันที่ จาก แผ่นงาน ฐานข้อมูลรายวัน D2 ไป แผ่นงาน สถิติ ที่คอลัมน์สุดท้าย และ ที่แผ่นงานใบลงเวลาทำงาน copy ข้อมูลจาก I7:I117 ไปแผ่นงานสถิติที่ใต้วันที่ จากที่ copy มา และปรับใช้ค่ำย่อจาก ไม่รูดเข้า/ออก เป็น ม , ขาด เป็น ข , ลากิจเป็น ก , ลาป่วยเป็น ป , ลาคลอดเป็น ค และ ไปราชการ เป็น ร
จาก Code ที่ผมใช้ ทำงานได้แค่ วันเดียว เช่นวันที่ 6 พอเรา ดึงข้อมูล วันที่ 7 เข้ามา ตัวแผ่นงานสถิติไม่เลื่อนเป็นคอลัมน์ใหม่ให้ครับ กลายเป็นว่าไปทับข้อมูลของวันที่ 6 แทน

รบกวนชี้แนะด้วยครับ :D
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ช่วยปรับสูตรให้หน่อยครับ

#17

Post by snasui »

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

Code: Select all

Sub เก็บฐานข้อมูล()
    Dim rngTarget As Range
    Application.ScreenUpdating = False
    Sheets("ใบลงเวลาทำงาน").Select
    Range("I7:I117").Select
    Selection.Copy
    Sheets("สถิติ").Select
    Set rngTarget = Range("a1").End(xlToRight).Offset(0, 1)
'    Range("C2").Select
    rngTarget.Offset(1, 0).Select

        
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("ฐานข้อมูลรายวัน").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("สถิติ").Select
'    Range("C1").Select
    rngTarget.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-th-TH,107]d mmm yy;@"
 '    Columns("C:C").Select
    rngTarget.EntireColumn.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Replace What:="ไม่รูดเข้า/ออก", Replacement:="ม", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ขาด", Replacement:="ข", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลากิจ", Replacement:="ก", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาป่วย", Replacement:="ป", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาคลอด", Replacement:="ค", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ไปราชการ", Replacement:="ร", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="สาย", Replacement:="ส", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
    Sheets("ใบลงเวลาทำงาน").Select
    Application.ScreenUpdating = True
End Sub
Top
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: ช่วยปรับสูตรให้หน่อยครับ

#18

Post by yangkodza »

snasui wrote: Sun Jun 12, 2022 10:08 pm :D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub เก็บฐานข้อมูล()
    Dim rngTarget As Range
    Application.ScreenUpdating = False
    Sheets("ใบลงเวลาทำงาน").Select
    Range("I7:I117").Select
    Selection.Copy
    Sheets("สถิติ").Select
    Set rngTarget = Range("a1").End(xlToRight).Offset(0, 1)
'    Range("C2").Select
    rngTarget.Offset(1, 0).Select

        
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("ฐานข้อมูลรายวัน").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("สถิติ").Select
'    Range("C1").Select
    rngTarget.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-th-TH,107]d mmm yy;@"
 '    Columns("C:C").Select
    rngTarget.EntireColumn.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Replace What:="ไม่รูดเข้า/ออก", Replacement:="ม", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ขาด", Replacement:="ข", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลากิจ", Replacement:="ก", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาป่วย", Replacement:="ป", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาคลอด", Replacement:="ค", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ไปราชการ", Replacement:="ร", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="สาย", Replacement:="ส", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
    Sheets("ใบลงเวลาทำงาน").Select
    Application.ScreenUpdating = True
End Sub
ขอบคุณมากครับอาจารย์ ตรงตามที่ต้องการครับผม :thup:
Top
Post Reply

Return to “Excel”