การแปลงข้อมูล

[Bafnet]

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

ติดใจครับ
ขั้นตอนคือ
1.Insert Procedure
2.ตั้งชื่อ
3.เลือกว่าเป็น Sub Function Property
4.เลือก Scope ว่า Public หรือ Private
จากนั้นเขียนคำสั่งที่ต้องการ ใช่ไหมครับ
แล้ววิธีเรียกใช้งานล่ะครับ
เขียนคำสั่งเรียกใช้อย่างไร

[snasui]

คำสั่งนี้ควรอยู่ท้าย ๆ ก่อน End Sub เลยครับ

Code: Select all

Application.ScreenUpdating = True

กรณีที่มีการ Select หรือ Activate เยอะ ๆ จะทำให้หน้าจอวูบวาบไปมา จึงต้องใช้คำสั่ง

Code: Select all

Application.ScreenUpdating = False

เพื่อป้องกันหน้าจอวูบวาบ ซึ่งจะทำให้ Code ทำงานช้าลงมาก และเมื่อทำงานเรียบร้อยแล้วค่อยเขียนคำสั่ง

Code: Select all

Application.ScreenUpdating = True

ส่วนการเรียกใช้ Code จาก Procedure อื่น ๆ ดู 8 บรรทัดแรกของ Link ด้านล่างนี้ได้เลยครับ จะประกอบด้วย Code ที่เขียนเรียกใช้ Procedure อื่น ๆ อย่างเดียวไม่มีคำสั่งอื่นปนเลย นั่นคือเขียน Sub Procedure แล้วก็ตามด้วยชื่อ Procedure ที่ต้องการใช้งานและปิดด้วย End Sub

viewtopic.php?p=8704#p8704

[Bafnet]

ดู 8 บรรทัดแรกของ Link ด้านล่างนี้ได้เลยครับ

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

อาจารย์ครับ มีเรื่องขอร้องหน่อยนะครับ

ผมต้องการให้ผู้ใช้เลือก combobox รายชื่อเอกสารซึ่งเป็น Word
แล้วสั่งพิมพ์เอกสารดังกล่าวครับ ตำแหน่งเอกสารคงที่ครับแค่ชื่อเอกสาร

Code: Select all

Private Sub CommandButton1_Click()
Dim wx As Variant
'On Error Resume Next
Application.ScreenUpdating = False
Set wx = Workbooks.Open("C:\Program Files\DumP\DATA\doc\" & ComboBox1 & ".doc", True, True)
wx.PrintOut
wx.Close False
Application.ScreenUpdating = True
'If Err > 0 Then
'MsgBox "Notfound Doc"
'End If
End Sub

อันนี้ผิดครับ แต่กลัวอาจารย์ว่าไม่ทำก่อน ผมคิดว่าผิดตรงคำว่า Workbooks.Open
เพราะ Workbooks.Open น่าจะหมายถึงไฟล์ Excel
รบกวนด้วยนะครับ

[Bafnet]

ผมได้ลองบันทึกมาโครแล้วครับ
อิอิได้ผลเป็นไม่มีอะไรเลยครับ
ช่วยด้วยนะครับ
ขอบคุณครับ

[snasui]

snasui เขียน:
ดู 8 บรรทัดแรกของ Link ด้านล่างนี้ได้เลยครับ

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

คลิก Link ที่ผมให้ไป รอจนโหลดเสร็จแล้วจับหน้าจอมาให้ดูหน่อยครับ อยากทราบเหมือนกันว่าที่บอกว่าไม่เห็นนั้นมันกลายเป็นหน้าไหน และจะเป็นหน้านั้นไปได้อย่างไร

[Bafnet]

สวัสดีครับ
ภาพแรก ที่ปรากฎ

untitled.jpg (78.99 KiB) Viewed 58 times

เมื่อเลื่อนไปดูที่หัวข้อ

aa.JPG (100.76 KiB) Viewed 58 times

หวังว่าอาจารย์คงไม่โกรธ ผมไปตามลิงค์จริงๆครับ

viewtopic.php?p=8704#p8704

[snasui]

ที่ผมล้อมกรอบสี่เหลี่ยมไว้นั้นคือการเรียกใช้ Procedure อื่นครับ

CallOterCode.png (231.03 KiB) Viewed 57 times

เป็นการเปิดด้วย Sub Procedure แล้วก็ตามด้วยชื่อของ Procedure ที่ต้องการเรียกใช้จากนั้นปิดด้วย End Sub

[snasui]

ตัวอย่างการเปิด Word, Print และ Close ตามด้านล่างครับ

Code: Select all

Sub OpenWordPrintAndClose()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = New Word.Application
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open("D:\Test.docx")
wdApp.PrintOut
wdApp.Quit
Set wdApp = Nothing
End Sub

Note: ก่อนจะเรียกใช้ Word ให้เข้าเมนู Tools > Reference > เลือก Microsoft Word ด้วยครับ

[Bafnet]

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

2. ฟังก์ชั่นสุดท้ายที่อยากให้โปรแกรมมี ขอให้ช่วยแนะนำหน่อยครับ มีปุ่มคำสั่งบนUserForm คลิ๊กแล้วเปิด URL ของเว็บที่กำหนดไว้ ให้LinK ไปที่เว็บนั้น
http://lotusnotes02/handbook/main.nsf

อาจารย์ช่วยหน่อยนะครับ

[Bafnet]

สวัสดีอีกครั้งครับ
ขอบคุณครับ ได้ผลครับ

[Bafnet]

มาอีกแล้วครับ
ที่บอกว่าหน้าตาประมาณนี้ล่ะครับ ผมเคยเห็นน่ะครับ

untitled.jpg

(53.38 KiB) Downloaded 36 times

[snasui]

ขอบคุณครับอาจารย์
ต้องขออภัยในความไม่รู้ของผมครับ
กลัวอาจารย์โกรธครับ

ไม่ต้องกังวลครับ ไม่มีเหตุผลใดที่ต้องโกรธครับ ผมแค่อยากทราบว่า Link มันทำงานถูกต้องหรือเปล่า เกรงว่าจะเป็นปัญหาที่ Forum น่ะครับ แต่เมื่อพบว่าปกติดีก็โล่งใจครับ

1.งานตกแต่ง ผมสั่งซ่อนชีททั้งหมดเหลือไว้แผ่นเดียว ไม่แสดงเส้นตารางดูว่างเปล่า
แต่อยากให้พื้นเซลของชีทนั้น มีลักษณะโปร่ง ทำได้ไหมครับ แต่เครื่องมืออื่นยังอยู่นะครับ

ลองใช้การ Minimize ดูครับ

Code: Select all

ActiveWindow.WindowState = xlMinimized

2. ฟังก์ชั่นสุดท้ายที่อยากให้โปรแกรมมี ขอให้ช่วยแนะนำหน่อยครับ มีปุ่มคำสั่งบนUserForm คลิ๊กแล้วเปิด URL ของเว็บที่กำหนดไว้ ให้LinK ไปที่เว็บนั้น
http://lotusnotes02/handbook/main.nsf

ลองใช้คำสั่งด้านล่างครับ

Code: Select all

Application.ThisWorkbook.FollowHyperlink "http://lotusnotes02/handbook/main.nsf"

[Bafnet]

สวัสดีครับอาจารย์
ตามที่อาจารย์ช่วยแปลงข้อมูล ขออนุญาตให้อาจารย์ช่วยปรับหน่อยนะครับ
หลังจากที่แปลงข้อมูลแล้วนะครับพบว่า มีข้อมูลทั้งสิ้น 17,785 รายการ (จากลูกค้า1763 ราย)
เป็นรายการที่ มี 0 ที่ต้องลบ 10,249 รายการ
มันเลยนานมากครับ จนผมว่าผู้ใช้ต้องคิดว่าระบบError
ผมเลยต้องการแสดง % ความคืบหน้าบนUserForm
แต่ผมใช้ Progressbar ที่เคยถามอาจารย์ไม่เป็น แต่วิธีที่ผมใช้และได้ผลพึงพอใจในระดับหนึ่ง
ลักษณะนี้ครับ

Code: Select all

Sheets("FileC").Activate
r = 2
Do Until Sheet10.Cells(r, 1).Value = ""
If Sheet10.Cells(r, 4).Value = 0 And Sheet10.Cells(r,2) And Sheet10.Cells(r,3) Then
......'คำสั่งที่ลบแถวCells(r, 4)ทั้งแถว
r = r + 1
frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ที่ตำแหน่งนี้มีการคำนวณเปอร์เซ็น
DoEvents
Loop

ผมลองนำไปใส่ในของอาจารย์ก็ไม่ได้ มัน DoEvents ไม่ได้
ครั้นใส่

Code: Select all

frmlone.TextBox1.Value = Sheet9.Range("AB1").Value

Code: Select all

frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ที่ตำแหน่งนี้มีการคำนวณเปอร์เซ็น
DoEvents

Sub DelZero()

Code: Select all

Dim rAll As Range
Dim r As Range
With Worksheets("Sheet2")
    Set rAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With
For Each r In rAll
    If r = 0 And r.Offset(0, 1) = 0 And r.Offset(0, 2) = 0 Then
        r = ""
    End If
frmlone.TextBox1.Value = Sheet9.Range("AB1").Value'ลองเพิ่มเข้าไป
Next r
    On Error Resume Next
    rAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

frmlone.TextBox1 มันก็แสดงผลเปอร์เซ็นตอนจบทีเดียว รบกวนปรับคำสั่งด้นบนให้ลบแถวที่ (r,4) หน่อยนะครับ
ขอบคุณครับ

[Bafnet]

สวัสดีครับอาจารย์ อาจารย์คงหลับแล้ว
ผมนั่งลองผิดลองถูกจนได้แบบนี้ครับ

Code: Select all

Sub Sed()
Dim r As Integer
Sheets("Sheet2").Activate
 r = 2
Do Until Sheet2.Cells(r, 1).Value = ""
If Sheet2.Cells(r, 5).Value = 0 Then
Sheet2.Rows(r).Select
Selection.Delete Shift:=xlUp
End If
r = r + 1
UserForm1.TextBox1.Value = Sheet2.Range("AB1").Value 
DoEvents
Loop
End Sub

ผมดีใจที่อย่างน้อยมันก็เริ่มลบแล้ว
แต่ทำไมมันลบไม่หมด ในคราวเดียว ลบครั้งแรกจาก 10,249 เหลือ 4,000 รบกวนดูให้หน่อยนะครับ
ที่ผมทราบจำนวนก็จาก AB1 = COUNTIF(E:E,0)
ขอบคุณครับ

[snasui]

ปกติการ Loop เพื่อลบบรรทัดเราจะลบจากล่างขึ้นบนครับ ถ้าลบคอลัมน์ก็ควรจะทำจากขวามาซ้าย ไม่เช่นนั้นก็จะเกิดปัญหาอย่างที่พบคือเกิด Error หรือลบไม่หมด

ผมปรับ Code มาให้แล้วตามด้านล่างลองทดสอบใช้งานดูครับ

Code: Select all

Sub Sed()
Dim r As Integer
With Worksheets("Sheet2")
    .Activate
    r = .Range("A1").End(xlDown).Row
    Do Until r = 1
        If .Cells(r, 5).Value = 0 Then
            .Cells(r, 5).EntireRow.Delete
        End If
        r = r - 1
        UserForm1.TextBox1.Value = .Range("AB1").Value
        DoEvents
    Loop
End With
End Sub

[Bafnet]

สวัสดีครับ
ขอบคุณมากครับ
จะพยายามต่อไปครับ

[Bafnet]

สวัสดีครับ
ถามต่ออีกสักนิดหนึ่ง
อย่างที่เรียนอาจารย์ว่าจำนวนข้อมูลมีจำนวนที่ไม่แน่นอน
เวลาผมกำหนดช่วงข้อมูลที่ไม่ทราบจำนวนที่แน่ชัด
ต้องกำนดเช่น Sheet2.Rang("A:AA") ซึ่งมันทำให้ช้า
มีความคิดในลักษณะนี้ได้ไหมครับ
1.พอเรานำเข้าข้อมูลมา ก็กำหนดสักที่หนึ่งเช่น AC1ให้
=COUNTA(A:A)-1 'ลบหัวแถว ซึ่งทำให้เราทราบจำนวนข้อมูล

Code: Select all

Sub a
Dim r As interger
Dim n As interger
 With Worksheets("Sheet2")
    .Activate
    r = 2
    n = Sheet2.Range("AC1").value 
      Do Until Sheet10.Cells(r, 1).Value = ""
Sheet10.Cells(r, 6).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T(n),3,0)"
Sheet10.Cells(r, 7).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6).Address & ",FileA!A1:G(n),5,0)" 
Sheet10.Cells(r, 8).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6) & ",FileA!A1:G(n),7,0)" 
Sheet10.Cells(r, 9).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 1) & ",FileB!A1:T(n),17,0)"
Sheet10.Cells(r, 23).Formula = "=VLOOKUP(" & Sheet10.Cells(r, 6) & ",FileA1!A1:G(n),3,0)"
TextBox7.Value = Sheet10.Range("P1").Value
DoEvents
r = r + 1
LoopEnd With
End Sub

Code: Select all

"=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T(n),3,0)"

มีลักษณะวิธีใช้อย่างนี้ไหมครับ
ถ้ามีแนะนำหน่อยนะครับ ระบบจะได้เร็วขึ้นสักนิด

[snasui]

"=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T(n),3,0)"

จาก Statement ด้านบน (n) จะทำงานไม่ได้ เนื่องจากไม่ถือว่าเป็นตัวแปร แต่กลายเป็นส่วนหนึ่งของ String ,FileB!A1:T(n),3,0)

หากต้องการใช้ให้เป็นตัวแปรน่าจะเป็นตามด้านล่างครับ

"=VLOOKUP(" & Sheet10.Cells(r, 1).Address & ",FileB!A1:T" & n & ",3,0)"

ลองปรับใช้ดูครับ

[Bafnet]

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

นี่นั่งรอมันลบมาจนอาบน้ำเสร็จ มันยังลบไม่เสร็จเลย
คอมผมที่ใช้ทำงานชิ้นนี้ก็แรงอยู่นะ


ถามต่อพลาง เรื่องเดิมล่ะครับ
จากข้อมูล อาจารย์จะเห็น ปี เดือน ไม่มีวัน
55 6
เรื่องรวมเลขให้เป็นวันที่พอทำได้
แต่จะทำยังไงครับให้เป็นวันที่สิ้นเดือนของเดือนนั้น เช่น A1=55 B1 = 55
55 6 ผมกะใส่ = (1 & "/"& B1 & "/" & A1)*1
1/6/55 ทำอย่างไรให้เป็นวันที่สิ้นเดือนครับ
อาจารย์ครับ นี่ขนาดตั้งกระทู้จะเสร็จ มันพึ่งวิ่งไปถึงบรรทัด 8000 กว่าเอง มีตั้ง17000 กว่าบรรทัด
ขอบคุณครับ ซักผ้าคงทัน

[snasui]

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

หากว่าในไฟล์มีฟังก์ชั่น Vlookup หรือพวก Volatile Function จำนวนมาก การลบบรรทัดย่อมช้าแน่นอนครับ เพราะจะเกิดการคำนวณทุก ๆ ครั้งที่มีการลบ

ลองเพิ่ม Code นี้ลงไปก่อนที่จะเป็น Code ลบบรรทัดครับ

Code: Select all

Application.Calculation = xlCalculationManual

เมื่อลบเรียบร้อยแล้วใช้ Code นี้เข้าไปปรับการคำนวณให้เป็น Automatic เหมือนเดิม

Code: Select all

Application.Calculation = xlCalculationAutomatic

ขนาดไฟล์โดยรวม หรือจำนวน Toolbox ที่อยู่บน UserForm มีผลหรือเปล่าครับ

คิดว่าไม่มีผลครับ

จะทำยังไงครับให้เป็นวันที่สิ้นเดือนของเดือนนั้น เช่น A1 = 55, B1 = 6

การแปลงโดยใช้สูตรสามารถทำดังนี้ครับ

=Date(Year,Month+1,0)

แทนค่าตัวแปร

=Date(A1,B1+1,0)

แต่ A1 ต้องเป็น 2012 ไม่ใช่ 55 ซึ่งแทน 2555 เนื่องจาก Excel ไม่รู้จักวันเดือนปีแบบ พ.ศ. ครับ