ดึงข้อมูลตามที่เลือกใน list

[snasui]

ผมไม่พบว่ามีชื่อไฟล์ Data_1.xlsx ใน Code ของไฟล์ที่แนบมานี้ ก็เป็นปกติที่จะเกิด Error ครับ

ที่แจ้งว่านำไปปรับใช้คือปรับตรงไหน อย่างไร ติดขัดบรรทัดไหน กรุณาแจ้งมาเสมอจะได้เข้าถึงปัญหาโดยไว ลักษณะการเกิด Error มีได้จำนวนมากและเป็นปกติของการเขียนโปรแกรมสำหรับมือใหม่ คุณ March201711 ต้องใช้เวลาศึกษาเรียนรู้ ทดสอบ ทดลองอีกมากถึงจะเขียนเองได้ ที่เขียนมาถามเป็นเพียงการบันทึก Macro มาอย่างง่าย ๆ เท่านั้น ทั้งยังเขียนมาไม่ครบทุกความต้องการ แต่ผมถือว่าได้พยายามมาก่อนจึงได้ตอบไปให้ครับ

สิ่งที่จะแนะนำก็คือให้หาตำรามาศึกษาเกี่ยวกับการเขียน VBA แล้วฝึกฝนไปตามนั้นก่อน เมื่อมีความพร้อมระดับหนึ่งจึงค่อยเขียนสร้างงานแล้วค่อยนำ Code มาถามกัน ไม่เช่นนั้นเมื่อเกิด Error เล็ก ๆ น้อย ๆ ก็จะแก้ปัญหาเองไม่ได้ครับ

[March201711]

click run แล้วแต่ข้อมูลไม่ดึงมาตามที่กำหนดที่cell t3ถึง v3 น่ะค่ะ ข้อมูลที่ดึงมาว่างปล่าวหมดเลยค่ะ

[snasui]

ผมตอบไปแล้วกรุณาอ่านให้เช้าใจครับ ถ้าไม่เข้าใจถือว่ายังไม่ควรใช้ Code ครับ

[March201711]

ค่ะ พยายามทำแล้ว ข้อมูลที่sheet result มันไม่มีข้อมูลที่ดึงมาค่ะ

[snasui]

อ่านโพสต์ที่ #21 แล้วแจ้งมาให้ครบถ้วนในกล่องความเห็นนี้จะได้ตอบต่อไปจากนั้น การใช้ Code จะต้องทราบได้ว่าบรรทัดไหนแสดง Error หรือไม่ทำงานครับ

[March201711]

มันทำงานนะคะ แต่ file data_1 มีข้อความที่ cell a1:c2ขึ้นมา ครั้งก่อนๆไม่มี และ ตรง cell p3 q3 ข้อมูลมีการ convert จาก text เป็น number ค่ะ ทำให้ดึงข้อมูลมาแล้วหายหมด

Code: Select all

 
    .Range("q1").Value = "Account"
    If c1 = 0 And c2 > 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 = 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 > 0 And c2 < c1 Then
        .Range("q2").Value = c1 & "*"
        .Range("q3").Value = c2 & "*"
        j = j + 2
    Else
        For i = 0 To c2 - c1
            .Range("q2").Offset(i, 0).Value = c1 + i & "*"
            j = j + i
        Next i
    End If
    Set cri = .Range("q1").Resize(j)
    rs.AdvancedFilter xlFilterCopy, cri, rt
    cri.ClearContents
End With 

มีผลกระทบอะไรกับcellนี้หรือป่าวค่ะ

[snasui]

การ Convert จาก Text เป็น Number มีผลทำให้ Data Type เปลี่ยนไป ทำให้ดึงข้อมูลไม่ได้ครับ

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

Code: Select all

Dim rs As Range, cri As Range
Dim rt As Range
Dim rtBook As Workbook
Dim dbBook As Workbook
Dim r As Range
Dim i As Integer, j As Integer
Dim c1 As Integer, c2 As Integer

Set rtBook = ThisWorkbook
Application.Calculation = xlCalculationManual
With rtBook.Worksheets("result")
    .Range("c2").CurrentRegion.ClearContents
    Set rt = .Range("a2")
    c1 = .Range("t3").Value
    c2 = .Range("v3").Value
End With
Set dbBook = Workbooks.Open(Filename:="C:\Users\toshibaW7\Desktop\Data_1.xlsx")
j = 1 'Criteria rows
With dbBook.Worksheets("sheet1")
    Set rs = .Range("a2", .Range("n" & .UsedRange.Rows.Count))
    With rs.Offset(0, 2).Resize(, 1)
        For Each r In .Cells
            r.Value = "'" & r.Value
        Next r
    End With
    .Range("q1").Value = "Account"
    If c1 = 0 And c2 > 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 = 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 > 0 And c2 < c1 Then
        .Range("q2").Value = c1 & "*"
        .Range("q3").Value = c2 & "*"
        j = j + 2
    Else
        For i = 0 To c2 - c1
            .Range("q1").Offset(i + 1, 0).Value = c1 + i & "*"
            j = j + i
        Next i
    End If
    Set cri = .Range("q1").Resize(j)
    rs.AdvancedFilter xlFilterCopy, cri, rt
    With rs.Offset(0, 2).Resize(, 1)
        .NumberFormat = "General"
        .Value = .Value
    End With
    cri.ClearContents
End With
For Each r In rt.CurrentRegion.Offset(0, 2).Resize(, 1).Cells
    r.NumberFormat = "General"
    r.Value = r.Value
Next r
Application.Calculation = xlCalculationAutomatic

[March201711]

ได้แล้วค่ะ code vba มีความซับซ้อนมากค่ะ ขอบคุณมากค่ะอาจารย์