Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://snasui.com/

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

https://snasui.com/viewtopic.php?t=1431

Page 3 of 6

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

Posted: Sun Aug 28, 2011 7:26 pm
by Bafnet
สวัสดีครับอาจารย์ ขอรายงานผล
19.20 พบทางออกครับ
จากใช้เวลาแปลง/ลบ 20 นาทีกว่า
เหลือ15 วินาที :lol:

Code: Select all

Sub DelZero()
Dim ri As Range
Dim ry As Range
Dim rx As Range
Dim cri As String
With Workbooks("DumP.xlsm").Worksheets("FileC")
Set ri = .Range(.Range("A2"), .Range("D65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
  Set rx = .Range(.Range("A1"), .Range("D65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
    
End With
With Workbooks("DumP.xlsm").Worksheets("Report")
Set ry = Workbooks("DumP.xlsm").Worksheets("Report").Range("A1")
End With
   Sheet10.Activate
           Sheet10.Range("A:D").AutoFilter Field:=4, Criteria1:=0
           
       ri.Select
       ri.Value = "0"
       Sheet10.ShowAllData
       Sheet10.Range("A:D").AutoFilter Field:=1, Criteria1:="<>0"
       rx.Select
       rx.Copy: ry.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            Sheet10.Activate
            Sheet10.ShowAllData
            Sheet10.Range("A:D").ClearContents
Sheet10.Range("A:D").Value = Sheet18.Range("A:D").Value
End Sub
จากความรู้ที่อาจารย์มอบมาทั้งนั้นเลยครับ
ขอบคุณมากครับ
อืม
snasui wrote:Application.Calculation = xlCalculationManual
มันทำให้ค่าของ

Code: Select all

TextBox7.Value = Sheet10.Range("P1").Value
DoEvents
ไม่แสดงผลครับ

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

Posted: Sun Aug 28, 2011 8:14 pm
by snasui
:lol: ยินดีด้วยครับ
Bafnet wrote:จากความรู้ที่อาจารย์มอบมาทั้งนั้นเลยครับ
ขอบคุณมากครับ
อืม
snasui เขียน:
Application.Calculation = xlCalculationManual

มันทำให้ค่าของ
โค้ด: เลือกทั้งหมด
TextBox7.Value = Sheet10.Range("P1").Value
DoEvents
ไม่แสดงผลครับ
ปกติถ้าใช้ Code ปรับการคำนวณเป็น Manual แล้วก็ควรปรับการนำค่าในเซลล์ไปแสดงด้วยครับ เพราะว่ามันจะหยุดการคำนวณไปแล้ว

Code ด้านล่างผมทำตัวอย่างมาให้เห็นว่าเราสามารถใช้การนับค่าที่เราลบให้แสดงใน TextBox โดยไม่ต้องอ้างอิงค่าจากเซลล์ใน Worksheet

Code: Select all

Option Explicit

Sub Sed()
Dim r%, c%
Application.Calculation = xlCalculationManual
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
        c = c + 1
        UserForm1.TextBox1.Value = "Deleted " & c & " Items"
        DoEvents
    Loop
End With
Application.Calculation = xlCalculationAutomatic
End Su

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

Posted: Wed Aug 31, 2011 5:13 pm
by Bafnet
สวัสดีครับอาจารย์
มีปัญหาใหญ่ครับ อาจารย์จำได้ไหมครับเรื่องที่แปลงข้อมูล

Code: Select all

lngLr = Rows.Count
Worksheets("DataC").Range("A1:E1").Copy Worksheets("FileC").Range("A1")
With Worksheets("DataC")
    Set rs = .Range("A2", .Range("B2").End(xlDown))
End With
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("A" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
Next lng
Set rs = rs.Offset(0, 2).Resize(, 3)
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("C" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
    Set rs = rs.Offset(0, 3)
Next
'Worksheets("FileC").Range("B1").EntireColumn.Delete
Application.CutCopyMode = False
Sheet22.Range("A:Z").ClearContents
Sheet22.Range("A2").Activate
Sheet10.Activate
Sheet10.Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
DelZero.DelZero
วันนี้ผมได้ทดลองนำโปรแกรมไปโหลดFileC ของหน่วยอำเภอที่มีลูกค้ามากกว่าของผม

Code: Select all

Sub DelZero()
Dim ri As Range
Dim ry As Range
Dim rx As Range
Dim cri As String
With Workbooks("DumP.xlsm").Worksheets("FileC")
Set ri = .Range(.Range("A2"), .Range("D65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
 Set rx = .Range(.Range("A1"), .Range("D65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
    
End With
With Workbooks("DumP.xlsm").Worksheets("Report")
Set ry = Workbooks("DumP.xlsm").Worksheets("Report").Range("A1")
End With
 Sheet10.Activate
 
           Sheet10.Range("A:D").AutoFilter Field:=4, Criteria1:=0
           
       ri.Select
       ri.Value = "0"
       Sheet10.ShowAllData
       Sheet10.Range("A:D").AutoFilter Field:=1, Criteria1:="<>0"
       rx.Select
      rx.Copy: ry.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
           Sheet10.Activate
            Sheet10.ShowAllData
            Sheet10.Range("A:D").ClearContents
Sheet10.Range("A:D").Value = Sheet18.Range("A:D").Value
End Sub
ปรากฏว่า DelZeRo ใช้การไม่ได้ ผมนั่งหาสาเหตุอยู่หลายชั่วโมงก็พบว่าเป็นเพราะจำนวนชุดข้อมูลที่เข้ามามีมากกว่า

Code: Select all

Set ri = .Range(.Range("A2"), .Range("D65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
ประมาณ 70000 กว่า เลยต้องแก้ไขเป็น

Code: Select all

Set ri = .Range(.Range("A2"), .Range("D1048576") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
ก็ได้ผลครับ หลังจากขจัดสัญญาที่เป็น 0 0 0 จาก 70000 เหลือ 20000
ก็ตกใจครับนั่งคิดว่านี่ขนาดสาขาต่างอำเภอเล็กๆ ไม่ใช่สาขาตัวจังหวัดซึ่งมีลูกค้ามากกว่านี้อีกมาก
ซึ่งมีปัญหาแน่ เพราะตอนแปลง 70000 กว่าขาดอีกไม่มากน้อยก็เต็มความจุ 1048576
ก็เลยต้องมาพึ่งอาจารย์ล่ะครับ
ตอนที่แปลงมาจากคำสั่งแรกด้านบนแบบฐานข้อมูล
อาจารย์ปรับให้ในขั้นตอนนั้นไม่นำส่วนที่เป็น 0 มาด้วยได้ไหมครับ
โดยมองที่ช่องจำนวนเงินเป็นหลักก็ได้ครับ คือถ้าเงินเป็นศูนย์ก็ไม่ต้องนำมา
รบกวนด้วยนะครับ
ขอบคุณครับ

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

Posted: Wed Aug 31, 2011 6:51 pm
by Bafnet
สวัสดีอีกครั้งครับ
อาจารย์ช่วยดูหน่อยนะครับ
จะทำอย่างไรให้ข้อมูลไปต่อท้ายครับ
ผมไม่ทราบจะทำยังไงแล้วครับ
เอามาเรียงได้แล้วโดยไม่เอาค่า0 แต่ส่งไปวางไม่ได้
แปลง.xlsm

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

Posted: Wed Aug 31, 2011 9:40 pm
by snasui
:lol: ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Private Sub CommandButton1_Click()
Dim r As Integer
Dim ra As Range, rb As Range, rc As Range, rt As Range, rs As Range, ry As Range
Sheets("sheet1").Activate
r = 2
Do Until Sheet1.Cells(r, 1).Value = ""
    If Sheet1.Cells(r, 4) <> 0 Then
        Sheet1.Range("AA8").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB8").Value = Sheet1.Cells(r, 2).Value
        Sheet1.Range("AC8").Value = Sheet1.Cells(r, 3).Value
        Sheet1.Range("AD8").Value = Sheet1.Cells(r, 4).Value
    End If
    If Sheet1.Cells(r, 7) <> 0 Then
        Sheet1.Range("AA9").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB9").Value = Sheet1.Cells(r, 5).Value
        Sheet1.Range("AC9").Value = Sheet1.Cells(r, 6).Value
        Sheet1.Range("AD9").Value = Sheet1.Cells(r, 7).Value
    End If
    If Sheet1.Cells(r, 10) <> 0 Then
        Sheet1.Range("AA10").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB10").Value = Sheet1.Cells(r, 8).Value
        Sheet1.Range("AC10").Value = Sheet1.Cells(r, 9).Value
        Sheet1.Range("AD10").Value = Sheet1.Cells(r, 10).Value
    End If
    If Sheet1.Cells(r, 13) <> 0 Then
        Sheet1.Range("AA11").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB11").Value = Sheet1.Cells(r, 11).Value
        Sheet1.Range("AC11").Value = Sheet1.Cells(r, 12).Value
        Sheet1.Range("AD11").Value = Sheet1.Cells(r, 13).Value
    End If
    If Sheet1.Cells(r, 16) <> 0 Then
        Sheet1.Range("AA12").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB12").Value = Sheet1.Cells(r, 14).Value
        Sheet1.Range("AC12").Value = Sheet1.Cells(r, 15).Value
        Sheet1.Range("AD12").Value = Sheet1.Cells(r, 16).Value
    End If
    If Sheet1.Cells(r, 19) <> 0 Then
        Sheet1.Range("AA13").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB13").Value = Sheet1.Cells(r, 17).Value
        Sheet1.Range("AC13").Value = Sheet1.Cells(r, 18).Value
        Sheet1.Range("AD13").Value = Sheet1.Cells(r, 19).Value
    End If
    If Sheet1.Cells(r, 22) <> 0 Then
        Sheet1.Range("AA14").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB14").Value = Sheet1.Cells(r, 20).Value
        Sheet1.Range("AC14").Value = Sheet1.Cells(r, 21).Value
        Sheet1.Range("AD14").Value = Sheet1.Cells(r, 22).Value
    End If
    If Sheet1.Cells(r, 25) <> 0 Then
        Sheet1.Range("AA15").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB15").Value = Sheet1.Cells(r, 23).Value
        Sheet1.Range("AC15").Value = Sheet1.Cells(r, 24).Value
        Sheet1.Range("AD15").Value = Sheet1.Cells(r, 25).Value
    End If
    With Worksheets("Sheet1")
        Set rs = .Range("AA8", .Range("AD15")).SpecialCells(2)
        Set rc = .Range("AE" & Rows.Count).End(xlUp).Offset(1, 0)
    End With
    On Error Resume Next
    rs.Copy: rc.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    r = r + 1
    Sheet1.Range("AA8:AD15").ClearContents
Loop
End Sub

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

Posted: Wed Aug 31, 2011 10:29 pm
by Bafnet
สวัสดีครับอาจารย์
ท้อครับ :roll:

Code: Select all

If Sheet1.Cells(r, 4) <> 0 Then
        Sheet1.Range("AA8").Value = Sheet1.Cells(r, 1).Value
        Sheet1.Range("AB8").Value = Sheet1.Cells(r, 2).Value
        Sheet1.Range("AC8").Value = Sheet1.Cells(r, 3).Value
        Sheet1.Range("AD8").Value = Sheet1.Cells(r, 4).Value
    End If
ที่ผมเขียนมา
มันก็ยังเอาค่าว่างไปอยู่ดี เช่นสองบรรทัดแรกเป็นค่าว่าง มันก็เอาค่าว่างไปต่อท้ายด้วย
แถมช้ามากมายสู้ของอาจารย์

Code: Select all

lngLr = Rows.Count
Worksheets("DataC").Range("A1:E1").Copy Worksheets("FileC").Range("A1")
With Worksheets("DataC")
    Set rs = .Range("A2", .Range("B2").End(xlDown))
End With
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("A" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
Next lng
Set rs = rs.Offset(0, 2).Resize(, 3)
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("C" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
    Set rs = rs.Offset(0, 3)
Next
'Worksheets("FileC").Range("B1").EntireColumn.Delete

สู้ไม่ไดจริง ถ้าให้มันไม่เอาค่าศูนย์ก่อนจะไปเรียงเป็นแถวจาก Code นี้ได้ไหมครับ
ขอนะครับ
ก่อนแปลงแถวยาวๆ มี 8000 กว่า แปลงเสร็จมี 70000 กว่าบรรทัด แม้จะกรอง 0 ออกภายหลังได้
แต่มันก็รวนตอนที่ มาวาง70000 บรรทัดนี่แหละครับ
ดังนั้นจึงอยากให้มันไม่เอาค่า 0 มาตั้งแต่แรกครับ

สงสารผมนะ :flw:

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

Posted: Wed Aug 31, 2011 10:40 pm
by Bafnet
อันนี้เอามาให้ดูเฉยๆครับ
เมื่อก่อนการนำข้อมูลงวดชำระผมใช้ตัวนี้ครับ มีพี่คนหนึ่งเขียนไว้ จากไฟล์ Text
แต่มันทำให้แสดงยอดหนี้ผิดไปเพราะพี่ท่านเขียนไว้ว่าถ้างวดแรกเป็น 0 ไม่ต้องเอาทั้งแถวมาเลย
แต่ในความจริงอาจมีงวดที่อยู่หลังจากนั้นไม่เป็น 0

Code: Select all

Case "FILEC" '----------------¤Òº----------------------------------------------------------------
            cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
            cn.Execute "DELETE * FROM FILEC_DUE "  'ÅéÒ§¢éÍÁÙÅ·Ñé§ËÁ´
            cSQL = "select *  from FILEC_DUE"
            rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
            
            Set oPROG2 = frmMain.ProgressBar2
            Open sFileOpen For Input As #1
            While Not EOF(1)
                         Line Input #1, sTemp
                         iMAX = iMAX + 1
            Wend
            Dim sACC   As String
            Close #1
            Open sFileOpen For Input As #1
                    Do While Not EOF(1)
                            Line Input #1, sTemp
                            sACC = Mid(sTemp, 1, 8)
                            
                            If Mid(sTemp, 14, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 10, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 10, 2) '»Õ
                                rs.Fields(2).Value = Mid(sTemp, 12, 2) 'à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 14, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 21, 4)  ' §Ç´´Í¡
                            If Mid(sTemp, 29, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 25, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 25, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 27, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 29, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 36, 4) ' §Ç´´Í¡
                            If Mid(sTemp, 44, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 40, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 40, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 42, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 44, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 51, 4)  ' §Ç´´Í¡
                            If Mid(sTemp, 59, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 55, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 55, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 57, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 59, 7) ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 66, 4) ' §Ç´´Í¡
                            If Mid(sTemp, 74, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 70, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 70, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 72, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 74, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 81, 4)  ' §Ç´´Í¡
                            If Mid(sTemp, 89, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 85, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 85, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 87, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 89, 7) ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 96, 4) ' §Ç´´Í¡
                            If Mid(sTemp, 104, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 100, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 100, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 102, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 104, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 111, 4)  ' §Ç´´Í¡
                            If Mid(sTemp, 119, 7) = "0000000" Then GoTo DOLOOP
                            rs.AddNew
                                rs.Fields(0).Value = sACC
                                'rs.Fields(1).Value = Mid(sTemp, 115, 4) ' §Ç´µé¹
                                rs.Fields(1).Value = Mid(sTemp, 115, 2) ' »Õ
                                rs.Fields(2).Value = Mid(sTemp, 117, 2) ' à´×͹
                                rs.Fields(3).Value = Mid(sTemp, 119, 7)  ' à§Ô¹
                                rs.Fields(4).Value = Mid(sTemp, 126, 4)  ' §Ç´´Í¡
DOLOOP: 'ǹÅÙ»ãËÁè
                            iLine = iLine + 1
                            oPROG2 = iLine / iMAX * 100

                    Loop
            Close #1
            rs.Update
            oPROG2 = 0
            rs.Close: cn.Close

Code: Select all

380305241560400364005604560500252005605560900042005609570900042005709000000000000000000000000000000000000000000000000000000000000
400199861560400210005604000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
440073001500500050735005500900030005009510900030005109520900030005209530900030005309540900030005409550900030005509560900030005609
440073002570900030005709000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
360297261560400100005604560500090005605560900080005609570900130005709000000000000000000000000000000000000000000000000000000000000
370252851560500100005605000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
440159231500500063685005500900031845009510900031845109520900031845209530900031845309540900031845409550900031845509560900031845609
440159232570900031945709000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
430173001560500600005605560900150005609570900150005709580900150005809590900150005909600900150006009610900150006109620900223556209
430173002630900450006309000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
430173181470300010104703500900088005009510900088005109520900165905209530900088005309540900088005409550900088005509560900088005609
430173182570900088005709580900088005809590900088005909600900088006009610900088006109620900088006209630900098006309000000000000000
430173183000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
420271691540500022005405540900011005409550900011005509560900011005609570900055005709000000000000000000000000000000000000000000000
460027541540400210005404540500770005405540600210005406550600210005506560600210005606570600240005706580600250005806000000000000000
540013001550900100005509560900100005609570900100005709580900100005809590900100005909000000000000000000000000000000000000000000000
540013261550900200005509560900200005609570900200005709580900200005809590900200005909000000000000000000000000000000000000000000000
530030831540900340005409550900340005509560900340005609570900340005709580900340005809000000000000000000000000000000000000000000000
460085381540500250005405541200150005412551200150005512561200150005612571200150005712581200150005812591200150005912601200150006012
460085382611200150006112621200150006212631200150006312641200150006412651200150006512661200150006612000000000000000000000000000000
460085461500500000005005501200000005012511200000005112521200080005212531200080005312541200080005412551200080005512561200100005612

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

Posted: Wed Aug 31, 2011 11:09 pm
by Bafnet
สวัสดีครับ ขอรายงานผลครับ
ที่อาจารย์ปรับให้เพิ่ม ขอบคุณครับ
ช่องว่างหายไปต่อกันลงมาดีครับ
แต่ยังเทียบไม่ได้กับ Code ของอาจารย์อันนี้ครับ

Code: Select all

lngLr = Rows.Count
Worksheets("DataC").Range("A1:E1").Copy Worksheets("FileC").Range("A1")
With Worksheets("DataC")
    Set rs = .Range("A2", .Range("B2").End(xlDown))
End With
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("A" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
Next lng
Set rs = rs.Offset(0, 2).Resize(, 3)
For lng = 1 To 8
    Set rt = Worksheets("FileC").Range("C" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
    Set rs = rs.Offset(0, 3)
Next
'Worksheets("FileC").Range("B1").EntireColumn.Delete
ทั้งเร็วและแรง
ผมต้องขออภัยด้วยที่ดูจะวุ่นวาย แต่ผมก็ต้องพึ่งอาจารย์ล่ะครับ
ผมนั่งคิดดูพึ่งถึงบางอ้อ
มีแปดงวดต่อ1บรรทัด มี 8000 บรรทัดก็จะได้ผล 64000 บรรทัด แต่มีบรรทัดที่มีค่าจริงแค่ 29000 เป็น0 ซะ 35000
ถ้าเจอสาขาที่มีสัก 15000 บรรทัดซึ่งมีแน่นอน แล้ว *8 นิ่งสนิทแน่ครับ :lol:

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

Posted: Thu Sep 01, 2011 11:43 am
by snasui
Bafnet wrote:สวัสดีอีกครั้งครับ
อาจารย์ช่วยดูหน่อยนะครับ
จะทำอย่างไรให้ข้อมูลไปต่อท้ายครับ
ผมไม่ทราบจะทำยังไงแล้วครับ
เอามาเรียงได้แล้วโดยไม่เอาค่า0 แต่ส่งไปวางไม่ได้
แปลง.xlsm
จากไฟล์ แปลง.xlsm ที่แนบมา ผมปรับ Code มาให้เป็นตัวอย่างตามด้านล่างครับ

Code: Select all

Option Explicit

Sub ReRangeData()
Dim rs As Range, rt As Range, r As Range, rAll As Range
Dim lng As Long, lngLr As Long, i As Integer, c As Integer
Application.ScreenUpdating = False
lngLr = Rows.Count
Worksheets("Sheet1").Range("A1:D1") _
    .Copy Worksheets("Sheet2").Range("A1")
With Worksheets("Sheet1")
    Set rs = .Range("A2", .Range("A2").End(xlDown))
End With
    i = rs.Count
For lng = 1 To 8
    Set rt = Worksheets("Sheet2").Range("A" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
    Set rs = rs.Offset(0, 1 + c).Resize(, 3)
    Set rt = Worksheets("Sheet2").Range("B" & lngLr).End(xlUp).Offset(1, 0)
    rs.Copy: rt.PasteSpecial xlPasteValues
    With Worksheets("Sheet2")
        Set rAll = .Range("C2").End(xlDown).Offset(-i + 1, 0).Resize(i)
    End With
    For Each r In rAll
        If r = 0 Then
            r = ""
        End If
    Next r
    rAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    With Worksheets("Sheet1")
        Set rs = rs.End(xlToLeft).Resize(i, 1)
    End With
    c = c + 3
Next lng
Application.ScreenUpdating = True
End Sub

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

Posted: Tue Sep 06, 2011 2:56 am
by Bafnet
สวัสดีครับอาจารย์ :lol:
หายไปหลายวัน..ไปอบรมมาครับ
รายงานผลครับ
จาก code ที่อาจารย์ให้มา ใช้ได้ดีครับ หลังจากที่ทดสอบโหลดและแปลงไฟล์C
จะมีก็ตอนที่มันคำนวณ Excel จะโชว์ not respond สักสองสามอึดใจ และแสดงอย่างงี้เป็นระยะๆ
อาจดูแล้วชวนตกใจ แต่ก็สำเร็จครับ ขอบคุณมากครับ

อาจารย์ครับวันนี้ขออนุญาตนำโจทย์เลขมาฝากนะครับ
ผม IF แล้ว If อีก แต่ยังดักไม่ได้รบกวนอาจารย์ดูหน่อยนะครับ
เป็นการเลื่อนงวดพักชำระหนี้ ในโครงการพักหนี้ครับ
งวดชำระ1.xlsx
หาทางออกให้หน่อยนะครับ
ขอบคุณครับ

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

Posted: Tue Sep 06, 2011 7:36 pm
by snasui
:lol: ลองดูตัวอย่างการคำนวณตามไฟล์แนบครับ แยกเป็นคอลัมน์ช่วยในการคำนวณและช่วงผลลัพธ์ จะช่วยลดความซับซ้อนสามารถทำความเข้าใจได้ง่ายขึ้น

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

Posted: Tue Sep 06, 2011 10:23 pm
by Bafnet
สวัสดีครับ
พึ่งดูงานของอาจารย์เมื่อครู่
ขอบคุณมากๆครับ เล่นเอาตาซึมอีกแล้ว
หลังจากตั้งกระทู้เมื่อวาน ผมก็นั่งทำยังไม่หลับไม่นอน
ก็พึ่งได้เมื่อกี้นี่เองครับ แต่ยังติดปัญหาว่าค่าที่เป็น 0 จะทำยังไงให้มันรู้ว่าต้องเติมเลขยังไง
ไหนๆก็พยายามแล้วก็ขอให้อาจารย์ดูหน่อย :lol:
งวดชำระ.xlsm
ขอบคุณมากๆครับ

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

Posted: Tue Sep 06, 2011 10:59 pm
by snasui
:D ดูตัวอย่างสูตรที่เซลล์ W31:W32 และคอลัมน์ AB ตามไฟล์แนบครับ

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

Posted: Wed Sep 07, 2011 1:08 pm
by Bafnet
สวัสดีครับอาจารย์
snasui wrote:ลองดูตัวอย่างการคำนวณตามไฟล์แนบครับ แยกเป็นคอลัมน์ช่วยในการคำนวณและช่วงผลลัพธ์ จะช่วยลดความซับซ้อนสามารถทำความเข้าใจได้ง่ายขึ้น
อาจารย์ครับทำไมเก่งจังครับ
ผมถามหน่อยนะครับ มันรู้ได้ยังไงครับว่าต้องขยายออกไป จำนวน 3 ปี_
จะว่าจากจำนวนบรรทัดที่เพิ่มขึ้นก็ไม่ใช่
รบกวนอธิบายหน่อยครับ
ขอบคุณครับ

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

Posted: Wed Sep 07, 2011 2:16 pm
by snasui
:D อยู่ที่การหา Logic เข้ามาจับครับ เงื่อนไขคือเดือน 5 และ ปีที่อยู่ถัดจากเดือน 5 จากตัวอย่างคือปี 57

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

=4-(MATCH(57,E35:E40,0)-MATCH(5,F35:F40,0))

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

Posted: Wed Sep 07, 2011 5:38 pm
by Bafnet
สวัสดีครับ
snasui wrote:อยู่ที่การหา Logic เข้ามาจับครับ เงื่อนไขคือเดือน 5 และ ปีที่อยู่ถัดจากเดือน 5 จากตัวอย่างคือปี 57

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

=4-(MATCH(57,E35:E40,0)-MATCH(5,F35:F40,0))
ถ้าตั้งข้อสังเกตุว่า เลข 4 ตัวหน้ามีความสัมคัญ
ถ้าผมให้ตำแหน่งหนึ่งสมมติ ว่าที่ A2 คือปีทีธนาคารระบุให้อนุญาตให้โครงการขยายออกไป 2 ปี
ดังนั้นที่ A2 = 3 (2+1)
=A2-(MATCH(57,E35:E40,0)-MATCH(5,F35:F40,0))
จะได้ไหมครับอาจารย์ผลของมันจะทำให้งวดแต่ละงวดขยายออกไปสองปีไหมครับ

ผมอยากให้โปรแกรมสามารถใช้งานได้ตลอดไปในอนาคต
หากธนาคารกำหนดขยายระยะเวลาใหม่อาจเป็น 1, 2, ...หรือ4
มี A2 = จำนวนปีที่ธนาคารอนุญาตให้ขยาย จะปรับอย่างไรให้
ที่อาจารย์ทำให้ใช้ได้ตลอดไป
ขอบคุณครับ

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

Posted: Wed Sep 07, 2011 5:46 pm
by snasui
:D ถ้าดูตาม Concept แล้วไม่น่าจะมีปัญหาใดครับ

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

Posted: Wed Sep 07, 2011 8:49 pm
by Bafnet
สวัสดีครับ
มีเรื่องอีกครับ :lol:

Code: Select all

Private Sub CommandButton1_Click()
Dim r As Integer
Dim m As Integer
If Sheet2.Range("A2").Value = "" Then
MsgBox "äÁèÁÕ¢éÍÁÙÅ", vbOKOnly, "DumP"
Exit Sub
End If
Sheet2.Range("Y1").Formula = "=COUNTIF(F:F,0)"
Sheet2.Activate
r = 2
Do Until Sheet2.Cells(r, 5).Value = ""
Sheet2.Cells(r, 19).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,2,0)"

Sheet2.Cells(r, 6).Value = Sheet2.Cells(r, 19).Value
Sheet2.Cells(r, 20).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,3,0)"

Sheet2.Cells(r, 7).Value = Sheet2.Cells(r, 20).Value
Sheet2.Cells(r, 21).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,4,0)"

Sheet2.Cells(r, 8).Value = Sheet2.Cells(r, 21).Value
Sheet2.Cells(r, 22).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 1).Address & ",Income!A:D,2,0)"

Sheet2.Cells(r, 19).Value = Sheet2.Cells(r, 22).Value
Sheet2.Cells(r, 22).Value = ""
Sheet2.Cells(r, 23).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 1).Address & ",Income!A:D,3,0)"

Sheet2.Cells(r, 20).Value = Sheet2.Cells(r, 23).Value
Sheet2.Cells(r, 23).Value = ""
Sheet2.Cells(r, 24).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 1).Address & ",Income!A:D,4,0)"

Sheet2.Cells(r, 21).Value = Sheet2.Cells(r, 24).Value
Sheet2.Cells(r, 24).Value = ""
r = r + 1
Loop
End Sub
รบกวนอาจารย์ปรับให้หน่อยครับ คือที่เว้นบรรทัดอยากให้มีคำสั่งตรวจค่าVlookuP ที่ #N/A ค่าError
ถ้าค่าที่เป็น Error ให้แสดงค่าเป็น ""

Code: Select all

Sheet2.Cells(r, 19).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,2,0)"
คำสั่งที่ดูก่อนว่าผลที่ Sheet2.Cells(r, 19) #N/A หรือไม่ถ้า เป็นก็ให้ Sheet2.Cells(r, 19)=""
Sheet2.Cells(r, 6).Value = Sheet2.Cells(r, 19).Value
ขอบคุณครับ

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

Posted: Wed Sep 07, 2011 9:04 pm
by snasui
:D ลองตามนี้ครับ

จาก
Bafnet wrote:Sheet2.Cells(r, 19).Formula = "=VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,2,0)"
เปลี่ยนเป็น

Code: Select all

Sheet2.Cells(r, 19).Formula = "=IF(ISNA(VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,2,0)),""""," & _
"VLOOKUP(" & Sheet2.Cells(r, 5).Address & ",Dayco!A:D,2,0))"
เปลี่ยนค่า Code อื่น ๆ เป็นแบบเดียวกัน > Run Code แล้วสังเกตดูผล และดูเหมือนยังพอใจกับการเลือกทั้งคอลัมน์อยู่เหมือนเดิมนะครับ :lol:

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

Posted: Wed Sep 07, 2011 10:40 pm
by Bafnet
สวัสดีครับ
snasui wrote:และดูเหมือนยังพอใจกับการเลือกทั้งคอลัมน์อยู่เหมือนเดิมนะครับ
:mrgreen:
snasui wrote:
Bafnet wrote:"=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)"

ลองปรับใช้ดูครับ
อ่า..เคยเอาแบบนี้ไปลองใช้แต่ดันไปใช้ในค่าแรงค์
Sheet10.Range("A1:T" & n & ") มันบัคครับ
ก็เลยกลัวๆ เลยรักคอลัมน์ซะอย่างงั้น :mrgreen:
ขอบคุณครับ
All times are UTC+07:00
Page 3 of 6

Powered by phpBB® Forum Software © phpBB Limited