Snasui Excel Forum

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

ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

http://www.snasui.com/viewtopic.php?t=6931

Page 1 of 1

ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 16, 2014 8:14 pm
by Somchai Saisamer
ผมดึงข้อมูลจาก mainsheet ไปไว้ที่ชีท "ช" โดนกดปุ่ม "Mon" แต่ ผลที่ได้มี่ปัญหาสองอย่างคือ
1.ที่แถว 17 เป็นแถวว่าง
2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)
จะแก้ไขได้อย่างไรครับ
Public Sub Moneyupdate()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With ActiveSheet

Set rAll = .Range("f17", .Range("f" & rl).End(xlUp))

End With

For Each r In rAll
If r = ActiveSheet.Range("m2") Then

lng = lng + 1
ReDim Preserve a(8, lng)
a(0, lng) = lng
a(1, lng) = r.Offset(0, -5)
a(2, lng) = r.Offset(0, -4)
a(3, lng) = r.Offset(0, -3)
a(4, lng) = r.Offset(0, -2)
a(5, lng) = r.Offset(0, -1)
a(6, lng) = r.Offset(0, 0)
a(7, lng) = r.Offset(0, 1)


End If
Next r
If lng > 0 Then
With Worksheets("ช")
.Range("A18", .Range("A" & rl).End(xlDown).Offset(0, 7)).ClearContents
Set rt = .Range("A17", .Range("h" & lng + 17))
rt = Application.Transpose(a)
End With
Else
MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 16, 2014 9:19 pm
by bank9597
:D ลองดูครับ
แก้ปัญหารูปแบบวันที่ ไปที่ control panel > language and region > Administrative > change system local แล้วเลือกเป็น thai ครับ

ส่วนตัวโค๊ด ขอรหัสผ่านด้วยครับ เข้าไปทดสอบโค๊ดไม่ได้

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 7:23 am
by Somchai Saisamer
ขอโทษครับ ผมลืมไปว่ามีรหัสครับ ผมแนบไฟล์ไม่มีรหัสมาใหม่แล้วนะครับ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 7:32 am
by Somchai Saisamer
bank9597 wrote::D ลองดูครับ
แก้ปัญหารูปแบบวันที่ ไปที่ control panel > language and region > Administrative > change system local แล้วเลือกเป็น thai ครับ

ส่วนตัวโค๊ด ขอรหัสผ่านด้วยครับ เข้าไปทดสอบโค๊ดไม่ได้
เข้าไปตั้งค่าตามที่คุณบอกแล้วนะครับ ค่าเดิมก็เป็น thai อยู่ครับ เลยได้ผลเหมือนเดิมครับ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 11:15 am
by bank9597
Somchai Saisamer wrote:ขอโทษครับ ผมลืมไปว่ามีรหัสครับ ผมแนบไฟล์ไม่มีรหัสมาใหม่แล้วนะครับ
:D ลองปรับโค๊ด :ard:
Public Sub Moneyupdate()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With ActiveSheet

Set rAll = .Range("f17", .Range("f" & rl).End(xlUp))

End With

For Each r In rAll
If r = ActiveSheet.Range("m2") Then

lng = lng + 1
ReDim Preserve a(8, lng)
a(0, lng - 1) = lng
a(1, lng - 1) = r.Offset(0, -5)
a(2, lng - 1) = r.Offset(0, -4)
a(3, lng - 1) = r.Offset(0, -3)
a(4, lng - 1) = r.Offset(0, -2)
a(5, lng - 1) = r.Offset(0, -1)
a(6, lng - 1) = r.Offset(0, 0)
a(7, lng - 1) = r.Offset(0, 1)


End If
Next r
If lng > 0 Then
With Worksheets("ª")
.Range("A18", .Range("A" & rl).End(xlDown).Offset(0, 7)).ClearContents
Set rt = .Range("A17", .Range("h" & lng + 17))
rt = Application.Transpose(a)
End With
Else
MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 1:23 pm
by Somchai Saisamer
bank9597 wrote:
Somchai Saisamer wrote:ขอโทษครับ ผมลืมไปว่ามีรหัสครับ ผมแนบไฟล์ไม่มีรหัสมาใหม่แล้วนะครับ
:D ลองปรับโค๊ด :ard:
Public Sub Moneyupdate()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With ActiveSheet

Set rAll = .Range("f17", .Range("f" & rl).End(xlUp))

End With

For Each r In rAll
If r = ActiveSheet.Range("m2") Then

lng = lng + 1
ReDim Preserve a(8, lng)
a(0, lng - 1) = lng
a(1, lng - 1) = r.Offset(0, -5)
a(2, lng - 1) = r.Offset(0, -4)
a(3, lng - 1) = r.Offset(0, -3)
a(4, lng - 1) = r.Offset(0, -2)
a(5, lng - 1) = r.Offset(0, -1)
a(6, lng - 1) = r.Offset(0, 0)
a(7, lng - 1) = r.Offset(0, 1)


End If
Next r
If lng > 0 Then
With Worksheets("ª")
.Range("A18", .Range("A" & rl).End(xlDown).Offset(0, 7)).ClearContents
Set rt = .Range("A17", .Range("h" & lng + 17))
rt = Application.Transpose(a)
End With
Else
MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
ขอบคุณครับ จะลองดูครับ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 1:31 pm
by Somchai Saisamer
ทดลองเปลี่ยนโค๊ดตามที่แนะนำแล้วครับ ใช้ได้ผลดี คำตอบตรงตามที่ต้องการ ข้อ1.ครับ ขอบคุณมากครับ
แต่ยังมีปัญหาเรื่อง รูปแบบวันที่ตามข้อ2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 3:07 pm
by bank9597
Somchai Saisamer wrote:ทดลองเปลี่ยนโค๊ดตามที่แนะนำแล้วครับ ใช้ได้ผลดี คำตอบตรงตามที่ต้องการ ข้อ1.ครับ ขอบคุณมากครับ
แต่ยังมีปัญหาเรื่อง รูปแบบวันที่ตามข้อ2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)
:D ยังแก้ไม่ได้ครับ เลยปรับโค๊ดใหม่ดังนี้

Code: Select all

Public Sub Moneyupdate()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rLast As Integer
    Dim name As String
    Dim i As Integer
    
    Set ws = Sheets("Mainsheet")
    Set ws1 = Sheets("ª")
    
    ws1.Range("A17:G100").ClearContents
    name = ws.Range("M2").Value
    rLast = ws.Range("A100").End(xlUp).Row
    
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            
    
    End If
    Next i
end if

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Tue Jun 17, 2014 3:20 pm
by Somchai Saisamer
bank9597 wrote:
Somchai Saisamer wrote:ทดลองเปลี่ยนโค๊ดตามที่แนะนำแล้วครับ ใช้ได้ผลดี คำตอบตรงตามที่ต้องการ ข้อ1.ครับ ขอบคุณมากครับ
แต่ยังมีปัญหาเรื่อง รูปแบบวันที่ตามข้อ2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)
:D ยังแก้ไม่ได้ครับ เลยปรับโค๊ดใหม่ดังนี้

Code: Select all

Public Sub Moneyupdate()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rLast As Integer
    Dim name As String
    Dim i As Integer
    
    Set ws = Sheets("Mainsheet")
    Set ws1 = Sheets("ª")
    
    ws1.Range("A17:G100").ClearContents
    name = ws.Range("M2").Value
    rLast = ws.Range("A100").End(xlUp).Row
    
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            
    
    End If
    Next i
end if
ใช้ได้แล้วครับตรงตามความต้องการ ขอบคุณมากครับที่กรุณาแนะนำ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 23, 2014 11:17 am
by Somchai Saisamer
bank9597 wrote:
Somchai Saisamer wrote:ทดลองเปลี่ยนโค๊ดตามที่แนะนำแล้วครับ ใช้ได้ผลดี คำตอบตรงตามที่ต้องการ ข้อ1.ครับ ขอบคุณมากครับ
แต่ยังมีปัญหาเรื่อง รูปแบบวันที่ตามข้อ2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)
:D ยังแก้ไม่ได้ครับ เลยปรับโค๊ดใหม่ดังนี้

Code: Select all

Public Sub Moneyupdate()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rLast As Integer
    Dim name As String
    Dim i As Integer
    
    Set ws = Sheets("Mainsheet")
    Set ws1 = Sheets("ª")
    
    ws1.Range("A17:G100").ClearContents
    name = ws.Range("M2").Value
    rLast = ws.Range("A100").End(xlUp).Row
    
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            
    
    End If
    Next i
end if
ขอโทษครับ มีปัญหาเพิ่ม มาครับ คือถ้ามีข้อมูลเยอะๆ ใช้ code ข้างบน จะช้ามากครับ พอแนะนำวิธีแก้ไขได้ไหมครับ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 23, 2014 11:21 am
by bank9597
Somchai Saisamer wrote:
bank9597 wrote:
Somchai Saisamer wrote:ทดลองเปลี่ยนโค๊ดตามที่แนะนำแล้วครับ ใช้ได้ผลดี คำตอบตรงตามที่ต้องการ ข้อ1.ครับ ขอบคุณมากครับ
แต่ยังมีปัญหาเรื่อง รูปแบบวันที่ตามข้อ2.รูปแบบวันที่ ที่ชีท "ช" เปลี่ยนไป (บางแถววันที่สลับกับเดือน)
:D ยังแก้ไม่ได้ครับ เลยปรับโค๊ดใหม่ดังนี้

Code: Select all

Public Sub Moneyupdate()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rLast As Integer
    Dim name As String
    Dim i As Integer
    
    Set ws = Sheets("Mainsheet")
    Set ws1 = Sheets("ª")
    
    ws1.Range("A17:G100").ClearContents
    name = ws.Range("M2").Value
    rLast = ws.Range("A100").End(xlUp).Row
    
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            
    
    End If
    Next i
end if
ขอโทษครับ มีปัญหาเพิ่ม มาครับ คือถ้ามีข้อมูลเยอะๆ ใช้ code ข้างบน จะช้ามากครับ พอแนะนำวิธีแก้ไขได้ไหมครับ
:lol: ตอนนี้ผมคิดได้แค่นี้จริงๆครับ

เดี๋ยวรอท่านอื่นมาเพิ่มให้อีกครั้งน่ะครับ สู้ๆ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 23, 2014 12:32 pm
by snasui
:D ลองเพิ่มการยกเลิกการ Update Screen เข้าไปช่วยครับ

Code: Select all

'Other code
Application.ScreenUpdating = False
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i
Application.ScreenUpdating = True
'Other code

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 23, 2014 1:12 pm
by Somchai Saisamer
snasui wrote::D ลองเพิ่มการยกเลิกการ Update Screen เข้าไปช่วยครับ

Code: Select all

'Other code
Application.ScreenUpdating = False
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i
Application.ScreenUpdating = True
'Other code
ขอบคุณครับ จะลองดูครับ

Re: ดึงข้อมูลวันที่แต่จัดรูปแบบไม่ได้

Posted: Mon Jun 23, 2014 1:45 pm
by Somchai Saisamer
snasui wrote::D ลองเพิ่มการยกเลิกการ Update Screen เข้าไปช่วยครับ

Code: Select all

'Other code
Application.ScreenUpdating = False
    For i = 17 To rLast
        If ws.Cells(i, 6) = name Then
            ws.Range(Cells(i, 1), Cells(i, 7)).Copy
            ws1.Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i
Application.ScreenUpdating = True
'Other code
ทดลองแล้ว ใช้ได้ครับ เร็วขึ้น คำตอบตรงตามต้องการครับ ขอบคุณครับ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited